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Part VI 

Program Services 



This part of the BUN™ I OS Guide discusses program execution, concurrent programming, and 
scheduling. 

The chapters in this part are: 

Understanding Program Execution 

Explains the static and dynamic structure of programs, including jobs, 
processes, interprocess communication, and semaphores. 

Building Concurrent Programs 

Shows you how to build concurrent programs, programs with multiple 
processes executing concurrently. 

Scheduling Explains how the system schedules processors, physical memory, and I/O 

devices. 

Program Services contains the following services and packages: 

concurrent programming service: 

Event_Admin 

Event_Mgt 

Job_Admin 

Job_Mgt 

Job_Types 

P ipe_Mgt 

Process_Admin 

Process_Mgt 

P roce ss_Mgt_Types 

Semaphore_Mgt 

Session_Admin 

Session_Mgt 

Session_Types 

scheduling service: 

SSO_Admin 
SSO_Types 

timing service: 

Clock_Mgt 

Protect ion_Key_Mgt 

Time_Zone_Map 

T imed_Reque s t s_Mgt 

Timing_Admin 

Timing_Conversions 

Timing_String_Con vers ions 

Timing_Utilities 

resource service: 

Resource_Mgt 
Resource_Mgt_AM 
Resource_Types 
Resource_Utilities 

program building service: 

Control_Types 
Debug_Support 
Domain Mgt 
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Execution_Support 
Link_By_Call 
Program_Mgt 
RTS_Support 

monitor service: 

Monitor_Defs 
Monitor Mgt 
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This chapter discusses what a program is and how it executes. It discusses the definition of a 
program, program structure, how a program is invoked, and how a program executes, including 
discussions of jobs, processes, the execution environment of processes, interprocess com- 
munication, process control, and the use of semaphores for mutual exclusion. 

VI-1.1 Definition of a Program 

As explained in the Program_Mgt package , there are four program types: executable 
programs, executable image modules, non-executable image modules, and views. As used in 
this chapter, the term program refers to an executable program or executable image module. 

An executable program is the end product of the compiler/linker translation process. The 
compiler translates source code into object modules, and the linker then links the object 
modules into an executable program. In other words, an executable program is a program in 
the conventional sense of the word. 

Like an executable program, an executable image module is the end product of the 
compiler/linker process. But unlike an executable program, it is an independently linked, 
protected, and potentially shareable module that provides the runtime environment of a 
program (for example, the language runtime system or the operating system). An executable 
image module contains data structures and subroutines that initialize the data structures. 

Before execution, a program has a static structure; that is, it is a collection of static, passivated 
objects that define the elements in a program : a program object, a global debug table, an 
outside environment object, and one or more domain objects (which reference other objects). 
Sections VI-1.2 through VI- 1.2. 8 (Pages VI- 1-2 through VI- 1-8) discuss the static structure of 
programs. 

During execution, a program has a dynamic structure; that is, it is a collection of dynamic, 
active objects that define the course of execution: a job, one or more processes, and one or 
more stacks. Sections VI-1.4 through VI-1.7 (Pages VI-1-9 through VI-1-17) discuss the 
dynamic structure of programs. 

VM.2 Program Structure 

This section discusses the static structure of programs. 

A program is a network of objects rooted in a program object. A program object is created by 
the linker and referenced by a program AD. After creating a program, the linker passivates the 
objects and stores the program AD in a directory . A program consists of: 

• A program object (Required) 

• A global debug table (Required) 

• An outside environment object (Required) 

• One or more domain objects (required), each referencing: 

- A static data object (Required) 

- An instruction object (Required) 

- A stack object (Created at run time, referenced by a subsystem ID) 
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- A public data object (Optional) 

- A debug object (Optional) 

TM 

- A handler object (Required only for BiiN Ada programs) 

Figure VI- 1-1 shows the static structure of a program. (The stack object is referenced via a 
subsystem ID, indicated by dashed lines). 
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Figure VI-1-1. Static Structure of a Program 



The following sections provide a brief introduction to these objects. For more detailed infor- 
mation, see: 

• The packages Program_Mgt, Domain_Mgt, Debug_Support, RTS_Support, and 
Execution Support. 



The BiiN Systems Compiler Interface Guide. 
The BiiN Application Debugger Guide. 

TM 

The BiiN Systems Linker Guide. 



VI-1.2.1 The Program Object 



The program object is created by the linker each time object modules are linked together. It 
serves as the root object of the program and contains: 

• The program name and version number. 

• The main entry point of the program. This consists of the domain AD and procedure 
number where execution is to begin; generally this procedure is a startup routine in the 
language's runtime system. 
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• An AD to the Global Debug Table (GDT). The GDT lists the compilation units that were 
linked to form the program. For each compilation unit, there is a reference to the debug 
object containing the debug information for that unit. 

• An AD to the Outside Environment Object (OEO). The OEO references the command 
definitions and messages associated with the program. These are used by the command 
language executive (CLEX). 

• A domain AD list. This is a list of the domains that make up the program. 
Figure VI- 1-2 shows the structure of a program object. 
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Figure VI-1-2. Program Object 



VI-1.2.2 The Domain Object 



Domain objects are created by the linker from object modules. Every program has one or more 
domains. Each domain contains: 

• An AD to a static data object. The static data object contains ADs to external domains and 
public data objects so that code in this domain can call procedures and reference data in 
other domains. The static data object usually contains an AD to the public data object of its 
own domain. 

• An AD to an instruction object. The instruction object contains the code for this domain. 

• A subsystem ID. The ID is used to allocate and reference a stack object at runtime. 

• An AD to a public data object. The public data object defines the data in this domain that is 
visible to other domains. 

• An AD to a handler object. The handler object contains the locations of handlers that 
should be invoked if a fault or exception occurs. 

• An AD to a debug object. The debug object contains information needed to debug the code 
in this domain. 
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• A procedure table. The procedure table lists the addresses and types of the procedures in 
this domain that can be called from other domains. 



Figure VI- 1-3 shows the structure of a domain object. 
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Figure VI-1-3. Domain Object 



VI-1.2.3 The Static Data Object 

The static data object contains data that cannot be referenced outside the current domain. If a 
program has only one domain, the static data object contains all variables having a global 
lifetime. If a program has several domains, variables referenced from another domain (for 
example, C foreign variables and Ada variables defined in packages with pragma 
external) must be allocated in the public data object 

The static data object also contains ADs to domains whose external procedures can be called 
from this domain, as well as ADs to objects containing data accessible from this domain. 

The static data object can also contain a heap area. Heap allocation routines in the language 
run-time system (RTS) can resize the static data object during execution. 

Figure VI- 1-4 shows the structure of a static data object. 
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Figure VI- 1-4. Static Data, Instruction, and Stack Objects 



VI-1.2.4 The Instruction Object 

The instruction object contains the code for all subprograms defined in this domain. It can also 
be used to store constant data (but not access descriptors). 

Figure VI- 1-4 shows the structure of an instruction object. 



VM.2.5 The Stack Object 

The stack object contains the frames used during subprogram call and return. Each frame 
contains the parameters, local variables, and housekeeping information related to a call. 

All domains in the same subsystem and executing in the same process share a single stack 
object. Domains in different non-null subsystems use different stack objects. 

The OS allocates the stack object when program execution begins and resizes it dynamically 
during execution. See Page VI- 1-9 for further information. 

Figure VI- 1-4 shows the structure of a stack object. 

VI-1 .2.6 The Public Data Object 

The public data object contains data that can be referenced from other domains (which have an 
AD to the public data object in their static data objects.) 
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Figure VI- 1-5 shows the structure of a public data object. 
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Figure VI-1-5. Public Data Object 



VI-1.2.7 The Debug Object 



The debug object contains compiler-generated debug information about the subprograms in the 
domain's instruction object. 

For each subprogram, the debug object has a debug unit that contains information about the 
blocks, variables, constants, types, and statements in the subprogram. 

Figure VI- 1-6 shows the structure of a debug object. 
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Debug Information 
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DEBUG OBJECT 
Figure VI-1-6. Debug Object 



VI-1.2.8 The Handler Object 



Communication between procedures typically occurs by executing explicit call/return instruc- 
tion sequences. However, another mechanism is required during fault handling and exception 
propagation. A domain's handler object identifies the language-defined runtime system (RTS) 
associated with each procedure in the domain. Each RTS has a trace fault handler, a nontrace 
fault handler, and a number of exception handlers. 

The OS handles all faults initially and handles some of them by itself. Upon encountering a 
fault it cannot handle, the OS needs to transfer control to the RTS fault handler corresponding 
to the procedure in which the fault occurred. However, the OS cannot identify the procedure's 
language and therefore cannot directly call the fault handler. Instead, it calls an RTS invoker 
routine which searches the handler object to locate the RTS's fault handler. The RTS invoker 
routine is defined by the linker. 

When an RTS needs to propagate an exception to another subsystem, the RTS calls the OS. 
As with a fault, the OS then calls the RTS invoker, which searches the handler object to locate 
the RTS's exception handler. (If the exception needs to be propagated to another procedure in 
the same subsystem, the RTS, not the OS, searches the handler object to locate the exception 
handler.) 

See the BUN™ Systems Compiler Interface Guide for more detailed information about the 
handler object. 



VM.3 Invoking a Program 

After creating a program, the linker passivates it. Some time later, at a user's request, the 

TM 

BiiN Command Language Executive (CLEX) invokes the program in the following way: 
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• 



A user requests execution of a program by typing the program's name on a terminal. 
• CLEX calls Directory_Mgt . Retrieve to obtain the program AD. 

CLEX uses the program's outside environment object (OEO) to validate the command line 



• 



• 



parameters. 

If the parameters are valid, CLEX sets up the job's environment variables and calls 
Job_Mgt . Invoke_ job to create the job and its initial process. 

A CLEX-supplied initial procedure — running in the new job's initial process — calls 
Progr amJMgt . Run (or Program_Mgt . Debug) with the program AD. Run (or 
Debug) then calls the program's main entry point. This activates the program, and causes 
the job's initial process to start executing the program's initial procedure. (This is usually a 
start-up routine in the language runtime system, from which control transfers to a procedure 
defined in one of the program's domains.) 

The program executes. After execution, control returns to CLEX (regardless of whether the 
program terminates normally or abnormally), and CLEX informs the user of the outcome 
(for example, printing any error messages). 

VI-1.4 Program Execution 

This section discusses the dynamic structure of programs. 

A program is executed by a job. The job's initial process begins execution in one domain, 
obtaining instructions from the instruction object and referencing local data and procedures 
through the static data object. 

At any time, the process may switch domains by making an interdomain call (a machine 
instruction) to a procedure in another domain. When this occurs, the new domain's subsystem 
ID is used to identify the new domain's stack object (If the new domain is in the same 
subsystem as the current domain, the same stack is used). A frame is pushed on the target 
stack and execution continues in the new domain. A return to the original domain is ac- 
complished by executing a return instruction using the caller's frame. 

During execution, the debug object and Global Debug Table are used by the debugger to debug 
the program (if the debugger was invoked). Also, the handler object is used by the RTS 
invoker routine to identify RTS fault and exception handlers, as described earlier. (See the 
BUN™ Application Debugger Guide and the BUN"* Systems Compiler Interface Guide for more 
detailed information.) 

During execution, a process may spawn other processes which execute concurrently. The 
following sections describe process behavior in greater detail. 

VI-1.4.1 Sessions, Jobs, and Processes 

A session is the collection of jobs executed during a user's interaction with the system. A 
session is usually an interactive logon/logoff period, and it typically contains several jobs. 

A job represents an executing program. Each job has its own address space, memory resource, 
and processing resource. Scheduling, resource control, and resource reclamation are done on a 
per-job basis. A job can contain multiple processes executing concurrently and sharing data 
and resources. 
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A process is one thread of execution within a job. Processes share the job's resources and 
cooperate to perform the job's computational task. A job begins with an initial process, which 
can spawn other processes. See Figure VI- 1-7. 



Job 




Figure VI-1-7. Job and Processes 



VI-1.4.2 Process Globals 



A process executes in an environment defined by its process globals, a list of ADs associated 
with the process. The entries in a process's globals are named by the 
Process_Mgt_Types .process_globals_entry enumeration type. 

Most process globals entries can be modified and assigned arbitrary ADs. Your application 
controls the correctness of modified entries: that they are not null, have needed access rights, 
and reference objects of the correct type. Often your application will not need to modify the 
process globals entries at all; values inherited from the command interpreter or the parent 
process will suffice. 

Table VI- 1-1 describes all the process globals entries. The "Inherited?" column indicates 
whether an entry is inherited when a process is spawned (designated by PS), a job is created 
(designated by JQ, or both (designated by PS/JQ. 

The "Modifiable?" column indicates whether a process globals entry can be modified. An 

entry can be modified when a process or job is created or by calling 

Process_Mgt . Set_process_globals_entry. In the "Modifiable?" column: 
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"Admin-only" Indicates that an entry can only be modified using the Pr oce s s_Admin 

or Job_Admin packages. 

"Process-only" Indicates that an entry can only be modified using P r o ce s s_Mgt or 
Process_Admin and cannot be modified using Job_Mgt or 
Job_Admin. 

" P r o c e s s_Admi n-only" 

Indicates that an entry can only be modified using the Pr oces s_Admin 
package. 

"Yes" Indicates that an entry can be modified using any of the four packages 

(Process_Mgt, Process_Admin, Job_Mgt or Job_Admin). 

"No" Indicates that an entry can NOT be modified using any of the four 

packages (Process_Mgt, Process_Admin, Job_Mgt or 
Job_Admin). 

Table VI-1-1. Process Globals Entries 



Entry 


Description 


Inherited? 


Modifiable? 


home_di r 


Process's home directory 


PS/JC 


Admin-only 


current_dir 


Process's current directory 


PS0C 


Yes 


authority list 


Default authority list for objects 
with master ADs stored by this 
process 


PS/JC 


Yes 


id_list 


IDs for whichprocess is granted 
access. First ID in list is owner 
ID and is default owner for ob- 
jects with master ADs stored by 
this process. Second ID in list is 

group ID for BiiN™/UX 
processes. 


PStfC 


Admin-only 


cmd_name_space 


Command name space used for 
retrieving command programs 
specified with relative pathnames 


ps/rc 


Yes 


standard_input 


Standard input opened device 


ps/rc 


Yes 


standard_output 


Standard output opened device 


PS/JC 


Yes 


standard_message 


Standard opened device for writ- 
ing information, warning, and er- 
ror messages 


ps/rc 


Yes 


user_dialog 


Controlling terminal. Used for 
operations on /dev/tty 


PS/IC 


Yes 


ux_environ 


Used for BUN /UX processes; 
null in other processes 


No 


Process_Admin-only 


lang_environ 


Used by language run-time sys- 
tem 


PS only 


Process_Admin-only 


site_environ 


Can be used by system ad- 
ministrator for site-specific pur- 
poses 


No 


Process_Admin-only 


transact ion_stack 


Stack of active transactions. If 
the stack is not empty, the top 
entry is the default transaction. 


No 


Process_Admin-only 


creator 


Process that created this process, 
with control rights. Null if this 
process is a job's initial process. 


No 


No 


process 


AD to this process, with control 
rights. 


No 


No 


job 


Job that contains this process, 
with list rights and control rights. 


Inherited when a 
process is spawned 
but not when a new 
job is invoked 


No 
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Table VM-1: Process Globals Entries (cont.) 


Entry 


Description 


Inherited? 


Modifiable? 


session 


Session that contains this 
process, with list rights and con- 
trol rights. 


Inherited when a 
process is spawned 
and normally when 
ajob is invoiced, 
butnotif a job 
is invoked using 
Job Admin and 
specifying a 
different session. 


No, but can be 
implicitly modified if 
a job is invoked using 
Job Admin and 
specifying a different 
session. 


name 


Optional AD to text record con- 
taining readable name for this 
process. 


No 


Process-only 


CLI_environ 


For use by Command Line Inter- 
preter (CLEX, for example). 


PS only 


Process-only 


program 


For use by the OS. 


PS only 


Process-only 


sms 


For use by the Software Manage- 
ment System. 


No 


Process-only 



VI-1.5 Interprocess Communication 

This section discusses events and pipes, two basic methods of interprocess communication. 

VI-1.5.1 Events 

Events are a mechanism for interprocess communication with these characteristics: 

• Events can be used as software interrupts, invoking event handler procedures and then 
continuing the interrupted processes. 

• Events can be used to send interprocess messages. Processes can wait for events to be 
received. If a process is not waiting, events can be queued until the process elects to 
receive the events. 

• Events can carry information between processes, either two words of immediate infor- 
mation or a pointer to a larger data structure. 

• Events signalled to a job are signalled to every process in the job. 

• Event clusters can be created to define additional event values or to define different process 
groupings: 

- An event cluster is specified by a process AD, job AD, or explicit cluster AD. 

- Each process has a predefined local event cluster, signalling an event using a process 
AD signals the local event cluster of that process. 

- A job has no cluster, signalling an event using a job AD signals the event to the local 
event cluster of every process in the job. 

- An explicit cluster is a global event cluster. Processes can associate and disassociate 
with global event clusters. Signalling an event using a global event cluster (AD) signals 
every process currently associated with the cluster. 

- The local event cluster is used for process control. See Page VI- 1-16. 

• Events can be signalled to remote processes or jobs. 

Events are grouped in event clusters, each with 32 event values. To signal an event , you call 
Event_Mgt . Signal with an action_record that specifies: 
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event An event value (1 to 32). 

me s s age A two-word virtual address. Can be used to send immediate data or a 

virtual address to the data. 

de st inat ion One of: 

1. Process with control rights. Event is signaled to the process's local 
event cluster. 

2. Job with control rights. Event is signalled to the local event clusters of 
all processes in the job. 

3. Global event cluster with signal rights. Event is signalled to all 
processes associated with the cluster. 

The action record specified to Event_Mgt . Signal is passed to any event handler or 
returned from any Event_Mgt . Wait_ call that receives the event. 

Each process controls how it will handle events with a particular event value by assigning the 
event_status record for that value: 

handler Handler to establish for event. If System . null_subprogram, default 

handler (if any) is reestablished. Otherwise, handler must be in a domain 
with a nonnull subsystem ID. 

state New event state. One of: 

enabled If the event has a handler, the handler is called for each 

event received. Otherwise, events are queued and can 
be dequeued using the Event_Mgt . Wait_ calls. 

di sabl ed Received events are discarded. If an event value's 

state is changed to disabled, any previously queued 
events for that value are discarded, emptying the 
queue. 

handler_disabled 

If the event has a handler, the handler is disabled. 
Received events are queued and can be dequeued using 
the Event_Mgt . Wait_ calls. If the event value's 
state is then changed to enabled and the event has a 
handler, then the handler is called for each queued 
event, emptying the queue. 

interrupt_system_call 

Flag indicating whether the handler can interrupt a blocked system call if 

the process is in the allow_sy stem_call_interrupt mode. (See 

the Typemgr_Support package and 

process_special_conditions 

. allow_system_call_interrupt in the Process_Mgt_Types 

package for further information.) 

Figure VI- 1-8 shows how received events are processed. 
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Figure VI-1-8. Events can be Handled, Queued, or Discarded. 

VM .5.2 Pipes 

A. pipe is an object that supports one-way I/O transfers between processes. 

Figure VI- 1-9 shows a pipe used for interprocess communication. One process has the pipe 
open for output and writes data to the pipe. A second process has the pipe open for input and 
reads the data written by the first process. The pipe contains a fixed-size buffer used to hold 
data written by the first process but not yet read by the second process. 
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Figure VI-1-9. Pipel70 



If a process writes to a pipe and there is not enough space in the buffer, then it can block, 
waiting for space to be freed by the reading process. If a process reads from a pipe but there is 
no data in the buffer, then it can block, waiting for data to be written by the writing process. 
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Pipes are one type of OS device. Pipes are implemented entirely in software; there are no 
underlying physical devices, such as terminals or disk drives, that correspond to pipes. Be- 
cause pipes are software devices, they can be freely created by executing programs, limited 
only by the amount of virtual memory available to the process. 

Pipes are useful because they eliminate the need for intermediate files by allowing the output 
of one program to be connected to the input of another program. This makes it easier to 
construct complex programs from smaller existing programs. Both the Command Language 
and the BiiN™/UX "shell" define an operator for piping, which takes two program invocations 
and connects them via a pipe. This chapter covers the procedural interface to pipes. 

Pipes support the Byte Stream Access Method and the Record Access Method. These I/O 
access methods provide calls to open pipes for I/O, perform I/O transfers, and close opened 
pipes. The Pipe_Mgt package provides calls to create pipes, check whether pipes are open 
for input or output, and check whether an arbitrary object is a pipe. The Pipe_Mgt package 
description also describes the pipe implementation of the I/O access methods. 

Once created, a pipe exists until no jobs reference it or until it is deallocated by calling 

Pipe_Mgt .Destroy. 



VI-1 .5.3 Pipes vs. Events 



Both pipes and events provide distributed interprocess or interjob communication. Some com- 
parisons will help you decide which mechanism to use for your application: 



• 



• 



In an application that uses pipes, a subprogram can be given an opened device and use the 
same code to read or write it whether the opened device is connected to a pipe, a file, or an 
interactive user. 

An application can send ADs and virtual addresses using events but not using pipes. 

If a message larger than two words is sent with an event, then additional message buffer 
space must be allocated and managed. Pipes can handle transfers of any size, even trans- 
fers larger than the pipe 's buffer. 

A pipe keeps the writing process from writing too much unread data, blocking the process 
(or optionally raising an exception) when the pipe buffer is full. A process signalling an 
event never blocks and queues of pending events can grow without limit. 

Handlers can be established for both events and for pipe input (using the 
Enable_input_notif ication I/O access method call). 



VI-1 .6 Process Control 

This section discusses the creation and control of processes. 

VI-1 .6.1 Process States 

A program creates a new process within its job by calling 

Process_Mgt . Spawnjprocess. 

Processes are controlled using local events, as described on Page VI-1- 16. By sending an 
event to a process, you can: 



Understanding Program Execution VI-1-15 



PRELIMINARY 

• Kill it immediately 

• Terminate it "gracefully", giving the process a chance to handle its own termination 

• Suspend its execution until a matching resume event is received 

• Resume its execution if it is suspended. 

After a process has terminated, you can deallocate all storage used by the process by calling 

Process_Mgt .Deallocate. 

Figure VI- 1-10 shows major process states and the transitions between them. 
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Figure VI-1-10. Major Process States 



VI-1.6.2 Local Event Cluster 



To kill, terminate, interrupt, suspend, or resume a process or job, signal the appropriate local 
event. Table VI- 1-2 describes all local event values. 

Table VI-1-2. Local Event Values 



Value 


Description 


Modifiable? 


Awaitable? 


Default 


user_l 
user~2 
user_3 
u$er_4 


Available for user. 
Not used by OS. 


Yes 


Yes 


Enabled. No default 
handler. 


kill 


Kills process im- 
mediately, even if 
handling another 
event 


No 


No 


Enabled. Default 
handler kills process. 


debug 


Requests debugging. 
Can interrupt any 
other event out kill. 


Eventjtdmin- only 


No, unless enabled 
using Event_Admin 


Disabled. 


termination 


Requests process ter- 
mination. 


Yes 


Yes if handler dis- 
abled. 


Enabled. Default 
handler kills process. 


interrupt 


Requests abort of cur- 
rent operation. 


Yes 


Yes if handler dis- 
abled. 


Enabled. Default 
handler kills process. 


suspend 


Requests suspension 
of process. 


Yes 


Yes if handler dis- 
abled. 


Enabled. Default 
handler increments 
suspend/resume 
count If count is now 
one, suspends 
process. 


resume 


Resumes process. 


No 


No 


Enabled. Default 
handler decrements 
suspend/resume 
count. If count is now 
zero, resumes process. 
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Table VI-1-2: Local Event Values (cont) 


Value 


Description 


Modifiable? 


Awaitable? 


Default 


hangup 


A dialup line con- 
nected to one of the 
process's opened 
devices has been hung 
up. 


Yes 


Yes if handler dis- 
abled. 


Enabled. Default 
handler kills process. 


io_complete 


Available to indicate 
completion of an 
asynchronous I/O 
operation. 


Yes 


Yes 


Enabled. No default 
handler. 


local_xm 


Available to signal 
resolution of a local 
transaction. 


Yes 


Yes 


Enabled. No default 
handler. 


gcol 


Signalled each time a 
local GCOL run 
begins in the 
process's job. 


Yes 


No 


Enabled. Default 
handler shrinks stacks 
if unused portions ex- 
ist. 


event_15 to 
event_32 


Reserved by OS. 


No 


No 


Disabled. 



VI-1 .7 Semaphores 



Processes can share data. But many operations on shared data will only execute correctly if 
executed by one process at a time. Other processes can be excluded during such an operation 
by associating a semaphore with the shared data structure. 

A semaphore is a system object that contains a count and, if the count is zero, a pointer to zero 
or more processes blocked at the semaphore. 

The basic operations on semaphores are P and V. If a semaphore's count is greater than zero, 
P indivisibly decrements it. Otherwise, P blocks the calling process in the semaphore's 
prioritized process queue. If processes are blocked at a semaphore, V unblocks and dispatches 
the highest-priority process. Otherwise, V indivisibly increments the semaphore's count. 

A third operation, Conditional_P, indivisibly decrements a semaphore's count if the count 
is greater than zero, returning true. If the semaphore's count is equal to zero, 
Conditional_P does nothing and returns false. A process uses Conditional_P to try 
to acquire a lock, without blocking if the lock is not available. 

A semaphore can be used to lock a data structure by interpreting a 1 count to mean that the 
data structure is available and a count to mean that the data structure is in use. Before 
accessing the data structure, a process calls P. If the data structure is available, the process 
continues and the semaphore's count becomes zero, indicating that the data structure is in use. 
If the data structure is being used by another process, the process calling P blocks in the 
semaphore's queue. After accessing the data structure, a process calls V. If another process is 
waiting, V dequeues the highest priority waiting process, leaving the count at zero, indicating 
that the data structure is still in use by the just dequeued process. If no processes are waiting, 
V increments the semaphore's count to one, indicating that the data structure is available. 

A semaphore used to lock a data structure is called a binary semaphore. Figure VI-1-1 1 shows 
binary semaphores. 
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Figure VI-1-11. Binary Semaphores 



A semaphore's count can also be used to count units of some resource. For example, a pack- 
age that manages a buffer pool can use a semaphore's count to indicate the number of free 
buffers in the pool. P decrements the count and is called when a buffer is allocated; V incre- 
ments the count and is called when a buffer is released. The semaphore that counts buffers can 
also be used to block processes that need a buffer when no buffer is available, and then to 
unblock a process when a buffer is released. In an implementation of the buffer pool package, 
a second semaphore is needed as a lock on the buffer pool data structure. A semaphore used to 
count units of some resource is called a counting semaphore. 

Semaphores are supported directly by the CPU. Semaphore objects are embedded directly in 
their object descriptors and require no additional active memory. The P, V, and 
Conditional_P operations are implemented as single machine instructions and execute 
very quickly. 

Semaphores are not distributed. A process can only use semaphores within its own job or 
within global objects on its node. 

Semaphores used as locks should be held for as short a time as possible, so that other processes 
are blocked less often and for a shorter time. You can use the Typemgr_Support package 
to defer event handling while the process is holding a lock (only for trusted type managers). 

A simple but serious bug occurs if a process uses a semaphore as a lock but never releases it 
for use by other processes. This could occur, for example, if the process executes a return, 
goto, exit, or raise statement without first calling V, or if an exception is propagated to 
the procedure in which the process is executing (preventing the process from calling V). 

This bug causes all subsequent processes that call P on the lock to block indefinitely, halting 
all or part of an application. The section "Locking Shared Data Structures" in Chapter VI-2 
shows how to write code that ensures that an acquired lock is always released. 

Killing or terminating a process that uses semaphores and shared data structures can leave data 
structures inconsistent and leave binary semaphores with zero counts, preventing other 
processes from using the data structures. Because semaphores and shared data structures are 
normally local to a job, this problem can be avoided by killing/terminating an entire job and 
not just a process within a job. 
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If an application must acquire multiple locks before executing certain operations, then the 
locks should always be acquired in the same order. Consider two processes executing an ap- 
plication. Process A acquires semaphore C first and is blocked waiting for semaphore 
D. Process B acquires semaphore D first and is blocked waiting for semaphore C. Neither 
process can execute; each waits for resources held by the other. This is a deadlock or "deadly 
embrace" bug that can halt all or part of an application. The bug is avoided if the semaphores 
are always acquired in the same order, such as <C, D>. 

VI-1.8 Use of Multiple Processes 

This section describes three general ways to use multiple processes: 

• Processes that do different tasks on data that flows from one process to the next. 

• Processes that do identical tasks on different parts of a large data structure. 

• Processes that have a client/server relationship in which the client sends a request to the 
server which sends a reply when the request has been processed. 

Some operations on a stream of data can be broken into different sub-operations that can be 
done by different processes. The entire concurrent program resembles an assembly line where 
the units of work (or packets of data) flow from one worker to the next, with each doing a 
special part of the entire operatioa 

Figure VI- 1-12 shows a compiler divided into separate processes to handle parsing and code 
generatioa Data flows through a pipe between the two processes, which can access the pipe 
using standard I/O access methods. 



Code 
Parsing Generation 

Process Process 

Pipe 



Source 

File 




7 Pipe I 7 



s^ Machine 
Code File 



Figure VI- 1-12. Processes Connected by a Pipe Speed Up a Compiler. 

Some applications that can use a piped design are: 

• Compilers 

• Text formatters 

• Format converters. 

Some computations involve repeatedly doing simple transformations to large arrays of data. 
Figure VI- 1-13 shows how such a computation can be speeded up by dividing it among mul- 
tiple processes that each perform the identical calculation on a portion of the array. 
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Compute A ( 1 .. 300_000 ) =? A ( 1 .. 300_000 ) * B ( 1 .. 300_000 ); 
Figure VI-1-13. Multiple Processes Speed Up a Large Array Calculation. 

Some applications that can use such a design are: 

• Image processing 

• Advanced computer graphics 

• Weather models 

• Models of air flow, fluid flow, heat flow, and other engineering properties 

• Linear programming 

• Monte Carlo simulations 

• Programs that examine many possible solutions, such as a chess-playing program or 
programs that optimize VLSI chip designs. 

Breaking an application into client and server processes can be useful when the application 
both requires interactive or realtime response and requires lengthy computations. Tasks that 
require lengthy processing are relegated to separate server processes. The interactive applica- 
tion sends requests to such server processes and can continue handling user input while the 
request is being processed. The server process sends a reply to its client when the request has 
been processed. Figure VI- 1-14 shows such a design, used for a word processor with a concur- 
rent spelling checker that checks each word entered by the user. 
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Figure VI-1-14. A Separate Spelling Checker Process Preserves Word 
Processor Responsiveness. 
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Server processes can be useful for applications such as: 

Concurrent spelling checking, grammar checking, or style checking. 
Incremental compilation of entered source code. 



Background generation of reports. For example, a process controlling a welding robot may 
spawn a server process that runs each hour to send operation statistics to a central com- 
puter. 

• Concurrent language translation: As text is entered in one window in one language, it is 
translated and displayed in another window in another language. The human translator can 
edit either window to correct errors in text input or the computer's draft translation. 

VM .9 Summary 

• The term program refers to an executable program or executable image module. 

• A program is a network of objects rooted in a program object created by the linker. It 
consists of a program object, a global debug table, an outside environment object, and one 
or more domain objects. Each domain object references a static data object, an instruction 
object, a stack object (referenced by a subsystem ID), a public data object, a handler 
object, and a debug object. 

• A program is invoked by CLEX upon user request. 

• A session is the collection of jobs executed during a user's interaction with the system. 

• A program executes as a job. Each job has its own address space, memory resource, and 
processing resource. Jobs are grouped into sessions. 

• A process is one thread of execution within a job. A job can contain multiple processes 
running concurrently and sharing data and resources. 

• Each process has an execution environment defined by its process globals. 

• Events provide flexible interprocess communication. 

• Events are used to control processes. 

• Pipes support one-way I/O transfers between processes or jobs. 

• Semaphores are used to synchronize access to shared data. 

• Concurrent processes can improve performance or responsiveness for a variety of applica- 
tions. 
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A concurrent program is one which has multiple processes executing simultaneously within a 
single job. Concurrent programs are suitable for a wide range of applications and can improve 
program performance dramatically. 

A process is one thread of execution within a job. Processes share the job's resources and 
cooperate to perform the job's computational task. A job begins with an initial process, which 
can spawn other processes. See figure VI-2- 1 . 



Job 




Figure VI-2-1. Job End Processes 



This chapter shows you some specific techniques for building concurrent programs. You 
should read chapter VI-1 before this one to understand the concepts underlying programs, 
processes, and interprocess communication (events, pipes, and semaphores). 
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Manages event clusters. Event clusters provide distributed communica- 
tions and software interrupts for processes. 

Manages pipes. A pipe is a one-way interprocess or interjob I/O channel. 
Pipes support byte stream I/O and record I/O. 

Provides public operations on processes. 

Process_Mgt_Types 

Declares types and type rights for processes. 

S emaph o r e_Mg t 

Manages semaphores. Semaphores can be used to synchronize concurrent 
access to shared data structures or resources. 



Packages Used: 

Event_Mgt 

Pipe_Mgt 
Process Mgt 



This chapter shows you how to: 
Get a process globals entry 
Set a process globals entry 
Create a process 
Get process information 
Suspend and resume a process 
Terminate a process 
Signal an event 
Establish an event handler 
Wait for events 
Connect processes with a pipe 
Lock shared data structures. 

Excerpts from the following examples in Appendix X-A are used: 

Compiler_Ex Shows how a compiler can be implemented by dividing parsing and code 
generation between two processes connected by a pipe. 

Process_Globals_Support_Ex 

Provides calls to get and set commonly used process globals entries for the 
calling process. 

S ymbo 1_T ab 1 e_E x 

Shows how a compiler's symbol table manager can synchronize concurrent 
access using semaphores. 

Word_Processor_Ex 

Shows how a word processor with a concurrent spelling checker can be 
implemented using processes and events. 

Appendix X-A contains complete listings for these examples. 
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VI-2.1 Getting a Process Globals Entry 



Calls Used: 

Process_Mgt . Get_process_globals_entry 
Gets a process globals entry. 



To get a process globals entry, call Get_process_globals_entry with the desired 

entry's name. Entry names are defined by the 

Process_Mgt_Types . process_globals_entry enumeration type. 

The following code is excerpted from the Process_Globals_Support_Ex package 
body: 

4 5 stdin: Device_Defs ,opened_device; 

4 6 stdin_untyped: System. untyped_word; 

47 FOR stdin_untyped USE AT stdin' address; 

4 8 begin 

4 9 stdin_untyped := Process_Mgt. 

50 Get_process_globals_entry ( 

51 Process_Mgt_Types .standard__input) ; 

62 RETURN stdin; 

Get_process_globals_entry always returns a value of type 
System. untyped_word. 

An optional second parameter to Get_j?rocess_globals_entry allows a caller to 
retrieve an entry from another process's globals, if the caller has control rights to the other 
process. 



VI-2.2 Setting a Process Globals Entry 

Calls Used: 

Process_Mgt . Set_process_globals_entry 

Assigns a value to a process globals entry. 



To assign a process globals entry, call Set_process_globals_entry with the desired 
entry's name and its new value. Entry names are defined by the 
Process_Mgt_Types .process_globals_entry enumeration type. 

The following code is excerpted from the Process_Globals_Support_Ex package 
body: 
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69 opened_dev: Device_Def s . opened_device) 

7 9 stdin_untyped: System. untyped_word; 

80 FOR stdin_untyped USE AT opened_dev' address; 

81 begin 

82 if not Byte_Stream_AM.Ops . Is_open (opened_dev) then 

83 RAISE Device_Defs .device_not_open; 
84 

85 elsif not Access_Mgt .Permits ( 

86 AD => stdin_untyped, 

87 rights => Device_Def s.read_rights) then 

88 RAISE System_Exceptions.insuf ficient_type_rights; 
89 

90 else Process_Mgt.Set_process_globals_entry ( 

91 slot => Process_Mgt_Types.standard_input, 

92 value => stdin_untyped) ; 

93 end if; 

A value assigned to a process globals entry must have type System . untyped_word. 



VI-2.3 Creating a Process 



Calls Used: 

Process_Mgt . Spawn_process 

Creates a new process in the caller's job. 



Creating a new process has two parts: 

1 . The program must define the initial procedure of the process in a specific way. 

2. The program then creates one or more processes that execute that initial procedure. 

This section's examples are excerpted from the Compiler_Ex package body. The first ex- 
cerpt shows how a process's initial procedure is defined: 

44 procedure Parse ( 

45 param_buf fer : System. address; 

4 6 — Address of connection record. 

47 param_length: System. ordinal) 

48 — Not used in this procedure, but required for 

4 9 — process's initial procedure. 
50 

51 — Logic: 

52 — Do Pascal parsing using the I/O connections 

53 — specified in the "conn_rec" parameter record. 

54 is 

5 5 conn_rec: connect ion_record; — Record containing 

56 — parameters. 

57 FOR conn_rec USE AT param_buf fer; 

58 begin 

63 end Parse; 

64 pragma subprogram_value (Process_Mgt . Initial_proc, Parse); 

The initial procedure must have the two parameters shown, param_buf f er and 
param_length, whether the parameters are used or not. The subprogr am_value 
pragma informs the compiler that Parse is an instance of the subprogram type 
Process_Mgt . Initial_proc, the type used for a process's initial procedure. 
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Parameters can be passed between parent and child processes by defining a record type, 
connect ion_record in this example, that contains the parameters as its fields. The parent 
process creates a connection record, fills in its fields, and passes its virtual address to the child 
process. The child process uses the FOR ... USE AT ... declaration to specify that its view of 
the connection record is at the virtual address specified by the parent. 



WARNING | 



If a parameter buffer specified to a child process is allocated as a local variable (that is, 
on the stack) of the parent process, then the parent process should not terminate, or return 
from the call that the buffer is local to, until after the child process terminates (otherwise 
the buffer would be inaccessible to the child). 

There are four different ways to pass information to a child process: 

1 . Use a parameter buffer local to the parent process. This technique is fine if the parent 
process does not terminate or return from the call that allocates the buffer until after the 
child process terminates. 

2. Use a parameter buffer allocated as a separate object from the job's heap. The parent 
process can terminate and the buffer will continue to exist. Such a buffer can be allocated 
by defining an access type to whatever type is used for the buffer, and then using the Ada 
new operator to create the buffer. 

3. Use a parameter buffer allocated in a package's static data area. This technique is un- 
desirable because the buffer cannot be used by concurrent parent processes that each need 
to communicate with their individual children. If such a parameter buffer is used by con- 
current parent processes, serious and hard-to-find bugs can result. If this technique is used, 
access to the parameter buffer should be guarded with a semaphore. 

4. Communicate via changes in the child's process globals. Such changes can be specified 
when the child is spawned. For example, consider a child process that reads its standard 
input and counts lines, writing the count to its standard output. The child does not need an 
explicit parameter buffer, it only needs to have its standard input and standard output con- 
nected to the desired opened devices. Changes in the child's process globals can be used 
alone or in combination with a parameter buffer. 

The second code excerpt shows how a process is created to execute a particular procedure: 

14 6 parsejprocess: Process_Mgt_Types.process_AD; 
147 — Process executing "Parse". 

176 parse_process := Process_Mgt . Spawn_process ( 

177 init_proc => Parse' subprogram_value, 

178 param_buffer => conn_rec' address, 

179 term_action => ( 

180 event => Event_Mgt .user_l, 

181 message => System. null_address, 

182 destination => this_process_untyped) ) ; 

The initial procedure to be executed is specified using the ' subprogramjvalue attribute. 

The address of the parameter record is specified using the ' address attribute. 

The t erm_act ion parameter is optional; it indicates the action to signal when the process 
terminates. 
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VI-2.4 Getting Process Information 



Calls Used: 

Process_Mgt . Get_process_state 
Gets a process's state. 



Get_process_state produces detailed state information for a process. The process state 
information is contained in a record of type 

Process_Mgt_Types .process_state_rec. Seethe Process_Mgt_Types pack- 
age description for more detailed information. 

The state information is a snapshot and can change at the same time that the information is 
being retrieved. For example, Get_process_state may indicate that a process is execut- 
ing even though it blocked while its state information was being retrieved. 

VI-2.5 Suspending and Resuming a Process 

Calls Used: 

Event_Mgt . Signal 

Signals an event. 

Process_Mgt . Suspend_caller 

Suspends the calling process. Is normally the last statement in a handler 
for the su spend local event. 



An application can suspend a process by signaling the Event_Mgt . suspend local event to 
the process. 

An application can resume a suspended process by signaling the resume local event to the 
process. 

A suspend or resume event can be signalled to all processes in a job by signaling the cor- 
responding event to the job. 

Signaling either event to a process or a job requires control rights. 

Each process has a suspend/ resume count A positive count is the number of suspend events 
received without a matching resume event. A negative count indicates the number of resume 
events that have been received without matching suspend events. Each suspend event received 
by a process increments the count, and each resume event received decrements the count. The 
suspend/resume count is zero when a process is created. The process is suspended whenever 
the count is greater than zero. Note that the resume event that matches a suspend event may be 
received before the suspend event. 

A process can control its response to suspend events, disabling them or establishing a handler 
for them. A handler for suspend events can simply do whatever cleanup is needed before the 
process suspends itself, and then call Process_Mgt . Suspend_caller to suspend itself. 
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VI-2.6 Terminating a Process 



Calls Used: 

Event_Mgt .Signal 

Signals an event. 

Process_Mgt . Terminate_caller 

Terminates the calling process. 

Process_Mgt . Deallocate 

Deallocates the storage used by a process, including the process object and 
process stacks. 



A process can terminate itself by: 

• Returning from its initial procedure 

• Raising an exception that is not handled within the process 

• Calling Terminate__caller. 

A process can terminate another process or a job by signaling the termination or kill 
local event to the process or job. (Recall that control rights are required to signal any event to 
a process or job.) The difference between the two events is that processes can control their 
response to termination events but not to kill events. 

A process may establish a handler for the t erminat ion event that does some cleanup and 
then calls Terminate_caller. 

A process cannot modify or establish a handler for kill events, which terminate a process as 
soon as they are received; kill events can interrupt other event handlers. 

When a process terminates, it may be desirable to free the memory that it used, by calling 
Proces s_Mgt . Deallocate. There is no way for a process that terminates itself to deal- 
locate itself, so deallocation is usually handled by the parent process. If a terminated process is 
not deallocated, its memory can still be reclaimed by garbage collection or at job termination. 

When a process creates a child process, it can specify an event to be signalled when the child 
terminates. The parent process can wait for that event or establish a handler for it. When the 
child terminates, the parent receives the termination event and deallocates the child's storage. 

The following excerpt from the Word_Processor_Ex package body shows how the word 
processor signals a concurrent spelling checker process to terminate, waits for the termination 
event, and then deallocates the spelling checker process. 

306 Event_Mgt .Signal (Event_Mgt .action_record' ( 

307 event => Event_Mgt .termination, 

308 message => System. null_address, 
30 9 — No message. 

310 destination => Conversion_Support__Ex. 

311 Untyped_f rom_j?rocess ( 

312 spelling_checker_process) ) ) ; 

313 Event_Mgt .Wait_for_any( 

314 events => ( 

315 child_termination_event_value => true, 

316 others => false) , 

317 action => child_termination_event) ; 

318 Process_Mgt .Deallocate (spelling_checker_process) ; 
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VI-2.7 Signaling an Event 



Calls Used: 

Event_Mgt . Signal 

Signals an event. 



To signal an event, call Signal with an action record that describes the event. 

The destination and event fields specify which event to signal. The message field 
can be used to send a message with an event, formatted as a virtual address. 

The following excerpt is from the Word_Processor_Ex package body. A spelling checker 
process has received the location of a word to check via a "word" event. If the word is 
misspelled, the spelling checker signals a "spelling error" event to the client process. 

162 if wo rd_mi spelled then 

163 Event_Mgt .Signal (Event_Mgt .action_record' ( 

164 event => spelling_error_event_value, 

165 message => ( 

166 offset => word_event. message. of f set, 

167 AD => System. null_word) , 

168 destination => word_event .message .AD) ) ; 

169 end if; 

The message .offset field of a spelling error event contains the word location, exactly as 
received earlier from the client process. The message . AD field is not used. The 
destination field is an AD to the client process being signalled. The "word" event 
received earlier from the client process contained this AD in its me s sage . AD field. 

TM 

A BiiN Ada representation specification can be used to pack several fields into the 
message . offset field. An excerpt from the Word_Processor_Ex package body il- 
lustrates this technique: 
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8 4 type word_record is record 

85 — This type encodes a word location into 32 bits, 

86 — allowing a word location to be transmitted 

87 — using the "message . of f set" field when an event 

88 — is signalled. The word processor and spelling 

89 — checker are presumed to share a two-dimensional 

90 — array containing the text being edited. Words 

91 — are presumed to not break across lines of the 

92 — array. A word location can thus be specified 

93 — as a line number, a starting column number, and 

94 — an ending column number. The encoding limits 

95 — line numbers to the range . . 65_535 and 

96 — column numbers to the range .. 255. 

97 line: System. short_ordinal; 

98 start_col : System. byte_ordinal; 

99 end_col: System. byte_ordinal; 
100 end record; 

101 

102 FOR word_record USE 

103 record at mod 32; 

104 line at range .. 15, 

105 start_col at range 16 .. 23, 

106 end_col at range 24 .. 31, 

107 end record; 

14 3 word_event: Event_Mgt .action_record; 

14 4 — Receives each word to be checked. 

14 5 current_word: word_record; 

14 6 FOR current_word USE AT word_event. 

14 7 message. off set' address; 

148 — Overlay used to extract word location, 



VI-2.8 Establishing an Event Handler 



Calls Used: 

Event_Mgt . Establish_event_handler 

Assigns handler and state for an event. Returns previous handler and state. 



Establishing an event handler has two parts: 

1. The program must define the handler procedure in a specific way. 

2. The program must call Establish_event_handler to connect the handler to the 
event. 

This section's examples are excerpted from the Word_Processor_Ex package body. The 
first excerpt shows how a handler procedure is defined: 
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178 procedure Spelling_error_handler ( 

179 action: Event_Mgt .action_record) 
180 

181 — Operation: 

182 — Handler invoked for each 'spelling error' 

183 — event. 

184 is 

185 misspelled_word: word_record; 

186 FOR misspelled_word 

187 USE AT action. message. offset' address; 

188 — Overlay used to extract word location. 

189 begin 

190 — Code to handle misspelled word goes here. For 

191 — example, this code could highlight the 

192 — misspelled word on the display and ring the 

193 — terminal's bell. 
194 

195 null; 

196 end Spelling_error_handler; 

197 pragma subprogram_value ( 

198 Event_Mgt .Event_handler, 

199 Spelling_error_handler) ; 

A handler procedure must have the action parameter shown, which is the event that invokes 

the handler. The subprogram_value pragma informs the compiler that 
Spelling_error_handler is an instance of the subprogram type 
Event_Mgt . Event_handler, the type used for all event handlers. 

The second excerpt shows how the word processor process establishes this handler: 

250 old_event_status: Event_Mgt.event_status; 

251 — Saves previous event status for the 

252 — spelling_error local event, so the previous 

253 — status can be restored before exit. 

271 old_event_status := Event_Mgt. 

272 Establish_event_handler ( 

273 event => spelling_error_event_value, 

274 status => ( 

275 handler => 

276 Spelling_error_handler' 

277 subprogram_value, 

278 state => Event_Mgt .enabled, 

279 inter rupt_system_call => false) ) ; 

When a subprogram establishes an event handler, and the subprogram is not the initial proce- 
dure or final procedure for its process, then it is good manners for the subprogram to restore 
the previous event status before returning to its caller 

320 old_event_status := Event_Mgt. 

321 Establish_event_handler { 

322 event => spelling_error_event_value, 

323 status => old_event_status) ; 

324 — Reestablish previous event status. 

325 — Value returned is never used. 



VI-2.9 Waiting for Events 
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Calls Used: 

Event_Mgt . Wait_f or_all 

Wait for all of a set of events within a cluster. 

Event_Mgt . Wait_f or_any 

Wait for any of a set of events within a cluster. 



Wait_f or_any is used to wait until any of a set of events within a cluster is received. The 
first event in the set that is received is assigned to an action record output parameter. The 
following excerpt from the Word_Processor_Ex package body shows the spelling checker 
process waiting for a word to be checked. 

143 word_event: Event_Mgt .action_record; 

14 4 — Receives each word to be checked. 

14 5 current_word: word_record; 

14 6 FOR current_word USE AT word_event. 

147 message. off set' address; 

148 — Overlay used to extract word location., 

152 Event_Mgt.Wait_for_any( 

153 events => (word_event_value => true, 

154 others => false) , 

155 action => word_event) ; 

Wait_f or_all is used to wait until all of a set of events within a cluster have been received. 
The received events are assigned to an array of action records. The following excerpt from the 
Compiler_Ex package body shows a parent process waiting for two child processes to ter- 
minate. 

152 term_events: Event_Mgt .action_record_list (2) ; 
154 — two child processes. 

192 Event_Mgt.Wait_for_all( 

193 events => 

194 (Event_Mgt.user_l .. Event_Mgt . user_2 => 

195 true, 

196 others => false) , 

197 action list => term events) ; 



VI-2.10 Connecting Processes with a Pipe 



Calls Used: 

Pipe_Mgt . Createjpipe 

Creates a pipe. 

Byte_Stream_AM . Ops . Open 
Opens a device. 



The following excerpt from the Compiler_Ex package body shows how a pipe is created 
and opened. 
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134 compilerjpipe: Pipe_Mgt .pipe_AD; 

135 — Pipe that connects "Parse" and "Code_gen" 

136 — processes. 

157 compilerjpipe := Pipe_Mgt .Create_pipe; 

158 

159 conn_rec := ( 

160 source_code => source_code, 

161 machine_code => machine_code, 

162 listing => listing, 

163 parse_out => Byte_Stream_AM. Ops .Open ( 

164 Pipe_Mgt .Convert_pipe_to_device { 

165 compiler_pipe) , 

166 Device_Def s. output ) , 

167 code_gen_in => Byte_Str eam_AM. Ops .Open ( 

168 Pipe_Mgt .Convert_pipe_to_device < 

169 compiler_pipe) , 

170 Device_Defs .input) ) ; 

The opened device ADs for the two open ends are stored in a "connection record" that is 
passed by address to each child process. Each child process can read the connection record 
and use the opened devices in it. 

The Parse process writes the results of its parsing to the conn_rec . par se_out opened 
device, the output end of the pipe. The Code_gen process reads the same parse results from 
the conn_rec . code_gen_in opened device, the input end of the pipe. 



VI-2.11 Locking Shared Data Structures 



Calls Used: 

Semaphore_Mgt . Create_semaphore 
Creates a semaphore. 

Semaphore_Mgt . P 

Enters/locks/waits at a semaphore. If the semaphore's current count is 
greater than zero, indivisibly decrements it. Otherwise, blocks the caller in 
the semaphore's prioritized process queue. 

SemaphoreJMgt . V 

Unlocks/leaves/signals a semaphore. If processes are blocked at the 
semaphore, unblocks and dispatches the highest-priority process. Other- 
wise, indivisibly increments the semaphore's current count. 



A data structure shared by multiple processes can be locked by locking an associated 
semaphore. To ensure that all processes observe the locking protocol, the data structure can be 
managed by a BiiN™ Ada package that handles all access to it. The Symbol_Table_Ex 
package manages a symbol table using such a locking protocol. 

The package body creates the symbol table at package initialization; the associated semaphore 
is created in the same code block: 
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5 8 lock : Semaphore_Mgt . semaphore_AD ; 

5 9 — Used to lock symbol table while a process 

60 — is accessing it. 

221 — PACKAGE INITIALIZATION 

222 begin 

229 symbol_t able. lock := Semaphore_Mgt . 

230 Create_semaphore; 

231 — Lock initially indicates table is available. 

232 — First "P" on lock will succeed. 

Each operation provided by the Symbol_Table_Ex package locks the semaphore at the 

beginning of the operation and unlocks the semaphore on all return and exception paths. The 

following excerpt is from the Read_symbol_data implementation in the package body. 
Note that the semaphore is locked once, but unlocked at each of several different exit paths. 

184 begin 

185 

186 Semaphore_Mgt .P (symbol_table. lock) ; 

194 for i in 1 .. symbol_table. length loop 

195 if symbol_t able .value (i) .name = 

196 f ixed_width_name then 

197 Semaphore_Mgt .V (symbol_table. lock) ; 

198 RETURN symbol_table .value (i) . data; 
199 

200 end if; 

201 end loop; 

202 RAISE no_such_symbol; 
203 

204 end if; 
205 

206 — This call to "V" is never reached in the 

207 — current implementation. The call is included 

208 — as a safeguard in case code changes make it 

209 — reachable. 

210 Semaphore_Mgt .V(symbol_table. lock) ; 
211 

212 exception 

213 when others => 

214 Semaphore_Mgt .V(symbol__table. lock) ; 

215 RAISE; — Reraise exception 

216 — that entered handler. 
217 

218 end Read symbol data; 
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This chapter explains how jobs and processes are scheduled. It discusses the scheduler's 
objectives and tasks, scheduling service objects (SSOs), CPU scheduling, memory scheduling, 
and I/O scheduling. 



VI-3.1 What the Scheduler Is 

The scheduler is a collection of hardware and software entities whose purpose is to schedule 
the execution of jobs (and thus processes). 

The scheduler is designed for multi-user systems, provides support for real-time applications, 
and withholds explicit control of scheduling from the user. 

The scheduler is not intended to be replaceable; instead, the system administrator can tailor a 
job's scheduling parameters to suit specific requirements. 



VI-3.2 The Scheduler's Objectives 



The scheduler's general objective is efficient use of the system's resources. Specifically, it 
seeks to: 

Maximize resource utilization 

Maximize system throughput 

Minimize response time for interactive users 

Avoid starvation of jobs 

Degrade gracefully under load 

Minimize thrashing. 

To accomplish these objectives, the scheduler is designed to favor: 
Interactive jobs 
I/O-bound jobs 
Jobs with small working sets 
Short jobs. 

and to handicap: 

Noninteractive jobs 

CPU-bound jobs 

Jobs with large working sets. 



VI-3.3 The Scheduler's Task 

A job needs three resources to execute: physical memory, processor time, and I/O devices. 
The scheduler attempts to balance the job's need for these resources against their availability 
and maximize resource utilization for all jobs in the system. 
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Thus, the scheduler's task is threefold: CPU scheduling, memory scheduling, and I/O schedul- 
ing. These are discussed in the following sections. 



VI-3.4 CPU Scheduling 

This section discusses CPU scheduling. 

VI-3.4.1 CPU Scheduling Model 

When a job is invoked (see Chapter VI- 1), it is enqueued on a scheduling port served by a 
scheduling daemon. Thereafter, scheduling occurs at three different levels: 

• High-level scheduling schedules jobs. 

• Medium-level scheduling assigns priorities to processes. 

• Low-level scheduling dispatches processes for execution on a processor. 

VI-3.4.1.1 High Level Scheduling 

When the scheduling daemon is activated, it removes a job from the scheduling port and 
schedules it by enqueueing the job's initial process at the end of one of the queues in a 
dispatching port. The port has 32 queues, ordered in priority from (lowest) to 31 (highest). 
(Note: Priorities 16-31 are reserved by the OS and never used by user processes.) A process 
enqueued in this manner is said to be in the mix. Putting a process in the mix is called 
high-level scheduling. See Figure VI-3- 1 . 
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Figure VI-3-1. High-level Scheduling 
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VI-3.4.1.2 Low Level Scheduling 



Each processor has a pointer to the dispatching port. When a processor is available to execute 
a process, it dequeues the first process from the highest numbered, non-empty queue in the 
port, and executes it. This is called low-level scheduling or dispatching; it is done by 
microcode, not software. See Figure VI-3-2. 
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Figure VI-3-2. Low-level Scheduling 



VI-3.4.1 3 Processor Preemption 

It is possible for a running process to be preempted (forced to relinquish the processor) by a 
process waiting in the dispatching port. Whether this occurs depends on the processes' relative 
priorities and the system's preemptive threshold. Currently the threshold is 8: if an interrupt 
handler or a process with a priority greater than or equal to 8 is ready to run, it will preempt a 
handler or process running with a lower priority. 

Note that the preemptive threshold may change. 

See Pages VI-3-6 and VI-3-7 for further information about process priorities. 

VI-3.4.1.4 Classes and Priorities 

Each job has a scheduling service object (SSO) that determines the type of scheduling service 
the job receives. Among other things, the SSO defines the job's service class and priority. 
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There are four service classes: real-time, time-critical, interactive, and batch. All the 
processes in a job have the job's service class; a job's service class never changes. 

There are 32 priorities, corresponding to the priorities in the dispatching port. 

See Page VI-3-6 for further information about service classes, priorities, and SSOs . 

VI-3.4.1.5 Processor Claim and Job Time Limit 

Each job has a processor claim that defines the number of time slices available to the job's 
processes in a scheduling cycle and a time limit that defines the total processing time available 
to the job (and its descendant jobs). 

All jobs have the same processor claim, but the length of the time slice given to a process is 
determined by the process's priority. 

A job's time limit is determined by by the t ime_limit parameter in the 

Job_Mgt . Invoke_job function. The exact interpretation of time_limit is subtle; see 

Invoke_ j ob for further information. 

When a time slice occurs, a time-slice fault-handler checks the processor claim: 

• If it is nonnegative, the time-slice fault-handler reduces it by one and gives the process 
another time slice by putting it at the tail of its priority queue in the dispatching port. 

• If it is negative, the time-slice fault-handler triggers a resource-exhaustion fault-handler, 
which checks the job's time limit. If the limit has been exceeded, the job is terminated; if 
not, the resource-exhaustion fault-handler replenishes the processor claim (charging it 
against the job's Resource Control Object (RCOj), and continues job execution. 

VT-3.4.1.6 Medium Level Scheduling 

The scheduling daemon puts real-time, time-critical, and interactive jobs into the mix im- 
mediately, but puts batch jobs in a waiting queue until system load allows them to be put in the 
mix. Once a process is in the mix, its scheduling depends on its priority, service class, and 
dynamic behavior. This is called medium-level scheduling, and is performed by hardware and 
the time-slice fault-handler. The following summarizes medium-level scheduling after a job 
has been put in the mix: 

• Real-time processes: 

- A real-time process is not subject to time slice faults; that is, it executes until it ter- 
minates or blocks for I/O. 

- If it blocks for I/O, hardware returns it to the front of its priority queue in the dispatch- 
ing port when the I/O completes. 

- It is up to the software designer to ensure that a real-time process does not starve other 
real-time processes and keep them from executing for too long a period. 

• Time-critical processes: 

- A time-critical process is subject to time slice faults. When a time slice fault occurs, it 
is handled as described in Section VI-3.4.1.5 on Page VI-3-5. 

- If a time-critical process blocks for I/O, it is treated like a real-time process. 

• Interactive and batch processes: 
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- An interactive or batch process is subject to time slice faults like a time-critical process 
and is treated in the same way, with one exception: if it receives an additional time 
slice, the time-slice fault-handler lowers the process's priority and places it at the tail of 
its new (lower) priority queue in the dispatching port. 

- If an interactive or batch process blocks for I/O, the time-slice fault-handler raises the 
process's priority to the priority of the requested I/O device, and places it at the tail of 
its new (higher) priority queue in the dispatching port when the I/O completes. This 
allows the process to issue several I/O requests for the device at the higher priority. 

- Note that the scheduling discipline for real-time and time-critical jobs is based on fixed 
priorities, but the scheduling discipline for interactive and batch jobs is based on 
dynamic, resource-driven priorities. See Page VI-3-7 for further information. 

VI-3.4.2 Scheduling Service Objects (SSOs) 

A Scheduling Service Object (SSO) is associated with a job when the job is invoked. The SSO 
determines the type of scheduling the job receives. 

The system administrator is responsible for creating different types of SSOs and controlling 
access to them, thus controlling the type of service granted to different jobs (see the 
SSO_Admin package). 

The SSO determines the job's service class, SSO priority, time slice, memory type, initial age, 
and age factor. 

VI-3.4.2.1 Service Classes 

Service class denotes the general class of service a job is to receive. Four service classes are 
defined: realtime, time-critical, interactive, and batch. 

Real-time jobs are executed in real time. They have very high priority and an infinite time 
limit. They run in frozen memory, and are not subject to the scheduling process. They are 
preemptive (given the current preemptive threshold) and always in the mix. If they block for 
I/O, the hardware reschedules them as soon as the I/O completes. 

Time-critical jobs have less stringent time constraints than real-time jobs. They have the 
same priority as real-time jobs, but a finite time limit (when a time slice expires, they are 
rescheduled or terminated). They need not run in frozen memory, since their time constraints 
can tolerate page faults. Like real-time jobs, they are preemptive (given the current preemptive 
threshold) and always in the mix. 

Interactive jobs involve interaction between a user and a job (an editing session, for example). 
Interactive jobs run in normal memory, have a finite time limit, and have a lower priority than 
real-time and time-critical jobs. 

Batch jobs are background jobs with no attached user. Like interactive jobs, they run in 
normal memory, have a finite time limit, and have a lower priority than real-time and time- 
critical jobs. 

VI-3.4.2.2 SSO Priority 

SSO Priority is the job's SSO priority. SSO priorities are defined as follows (higher values 
indicate higher priority): 
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16-31 Reserved for interrupt handlers; not available for program execution. 

75 Timing daemon. 

12 - 14 Real-time and time-critical jobs. 

1 1 Scheduler and other well-behaved system jobs. 

0-10 Interactive and batch jobs. 

As noted earlier, a handler or process with a priority greater than or equal to the preemptive 
threshold will preempt a processor from a handler or process running at a lower priority. A 
handler or process with a priority lower than the preemptive threshold cannot preempt a 
processor. The current preemptive threshold is 8; it may change in the future. 



VI-3.4.2.3 Time Slice 



Time slice is the amount of processing time assigned to each process in the job in each dis- 
patching cycle. (It does not include time spent on such incidents as interrupts, processor 
preemption, or waiting at a port or semaphore). 

When a process exhausts its time slice, it is handled as described in Section VI-3.4.1.5 on Page 
VI-3-5. 

For additional information about how time slices are interpreted for different classes of jobs, 
see time_slice_enabled, time_slice_reschedule, and time_slice in 
SSO_Types . SSO_Ob ject. 



VI-3.4.2.4 Memory Type 



Memory type is the type of memory in which the associated job should run. There are two 
types of memory: frozen and normal. Frozen memory is nonswappable, nonrelocatable 
memory; it is used for jobs that cannot tolerate page faults (real-time jobs, for example). Nor- 
mal memory is swappable and relocatable. 



VI-3.4.2.5 Initial Age 



Initial age is a job's age when it first enters the scheduler's waiting queue of swapped-out jobs 
(see page VI-3-9). Larger values indicate older jobs. The job at the head of the queue is the 
oldest job and will be scheduled next. Giving a job a large initial age helps move it to the head 
of the queue more rapidly. 



VI-3.4.2.6 Age Factor 

Age factor is the rate at which a job ages in the scheduler's waiting queue. On every scan of 
the waiting queue, the age factor is added to the job's age to determine a new age. The larger 
the aging factor, the faster a job ages, and the sooner it rises to the front of the waiting queue. 

Note that care should be used before assigning an age factor of to a job. Such a job will 
never age, and may therefore starve in a busy system. 

VI-3.4.3 Resource-Driven Priorities 

A single, fixed priority (SSO priority) is used to schedule real-time and time-critical jobs, and 
their priority is unaffected by resource usage. In contrast, scheduling for interactive and batch 
jobs uses several priorities and is dynamically driven by resource usage. 
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VI-3.4.3.1 Priorities Used 

The priorities used in scheduling interactive and batch jobs are: 

SSO priority The priority defined in the job's SSO. 

Base priority The lowest priority a process can have. 

A process's base priority is set when the process is created. The base 
priority of an initial process in a job is the job's SSO priority. The base 
priority of a spawned process is the base priority of its parent process. 

The System Administrator can change a process's base priority to any 
value; a user can change it to a value less than or equal to the job's SSO 
priority. 

Changing a job's base priority is accomplished by changing the base 
priorities of all the job's processes. 

Resource priority The priority assigned to a particular resource. 

When a process blocks on a resource, its priority is raised to the resource 
priority (unless its priority is already higher, in which case its priority 
remains unchanged). 

After using a resource, a process must return to its base priority. Each 
resource class specifies the amount of time in which this must occur. The 
process's priority is decreased linearly from the resource priority to the 
base priority in the specified amount of time. 

Running priority The priority at which an interactive or batch process is currently running. 

Running priority is determined by the other priorities. 

VI-3.4.3.2 An Example 

Consider I/O resources as a example (but note that the discussion is applicable to any resource 
managed by the scheduler). 

I/O resources are divided into different classes and each class is assigned a priority; for ex- 
ample, terminals might have priority 10, disks priority 9, and communication lines priority 8. 
(To keep process priorities less than or equal to 10, all resources have priorities less than or 
equal to 10). 

A process begins executing at its base priority (say, 5) and stays there until it blocks on an I/O 
resource (say, disks). While blocked, its priority is raised to the disk's priority (9). After the 
I/O, its priority is decreased linearly (by the same amount at each time slice) until it returns to 
its base priority (5). 

As the process alternates between CPU usage and I/O requests, its priority fluctuates between 
its base priority and the priority of the I/O resources it requests (these may be different 
resources with different priorities). The process terminates at some priority level between its 
base priority and the priority of the I/O resource it last requested. 

The presumption behind raising a process's priority to the resource's priority is that if the 
process issues one request for the resource, it is likely to issue another soon. The overall effect 
of the model is to favor I/O-bound jobs and penalize CPU-bound jobs, thus maximizing the use 
of system resources. 
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VI-3.5 Memory Scheduling 

This section discusses memory scheduling. 

Before a process can compete for CPU time, some of its instructions and data must be present 
in physical memory. (Invoking a job causes a series of faults that bring the program object, 
domain object, and other objects into primary memory; see Chapter VI- 1). Thus, physical 
memory is as important a resource as the CPU, and memory scheduling is an important part of 
the scheduler. 

The major goal of memory scheduling is to implement the working set model of memory 
management. The working set of a job is dynamically defined as the set of primary memory 
pages referenced by the job in the last time quantum, T, measuring backwards from a given 
time t. These are the pages which the job used most recently; identifying them and keeping 
them in memory reduces page fault rates and contributes to system efficiency. (See any stan- 
dard operating system text for more information about the working set model). 

Memory scheduling uses the following model: 

• The system maintains a pool of free pages of primary memory. 



• 



• 



• 



• 



As long as there are enough pages in the pool, all the jobs in the mix are allowed to remain 
there and new jobs are allowed to enter the mix. 

To guard against the depletion of the pool, the scheduler periodically examines memory 
usage by all the jobs in the mix and transfers back to the pool any pages that are not in the 
working set of some job. This is done by examining each job's Storage Resource Object 
(SRO). The SRO references a list of the pages each job has in primary memory. Any page 
that has not been accessed or modified in the last time quantum, T, can be returned to the 
pool. This is known as SRO page replacement 

When the number of free pages in the pool falls below a low water mark, the scheduler tries 
to get more free pages by triggering SRO page replacement more oftea If that doesn't 
succeed, the scheduler then pulls jobs out of the mix and releases their pages. The pages 
are given to the pool, and the jobs are swapped out to secondary memory. The scheduler 
keeps a waiting queue of swapped-out jobs. 

In order to achieve fair treatment for all jobs, the scheduler periodically examines the wait- 
ing queue and puts the job at the head of the queue in the mix. This ensures that no job 
starves while waiting for memory. The aging parameters in a job's SSO (init ial_age 
and agejactof) determine the job's position in the waiting queue. 

The scheduler also periodically triggers global SRO page replacement, which attempts to 
free pages from the normal global SRO (pages in the frozen global SRO are not replaced). 



VI-3.6 I/O Scheduling 



I/O scheduling is done implicitly through the mechanism of resource-driven priorities, as 
described above. 



VI-3.7 Summary 



The scheduler is a collection of hardware and software entities whose purpose is to 
schedule the execution of jobs (and thus processes). 



Scheduling VI-3-9 



PRELIMINARY 



The scheduler's general objective is efficient use of system resources. 

The scheduler's task is to perform CPU scheduling, memory scheduling, and I/O schedul- 
ing. 

The type of CPU scheduling a job receives is determined by the SSO associated with the 
job when it is invoked. The SSO determines the job's service class, priority, time slice, 
memory type, initial age, and age factor. 

The scheduling daemon puts real-time, time-critical, and interactive jobs into the mix im- 
mediately, but puts batch jobs in a waiting queue until system load allows them to be put in 
the mix. Once a process is in the mix, its scheduling depends on several factors. 

The scheduling discipline for real-time and time-critical jobs is based on a fixed priority, 
but the scheduling discipline for interactive and batch jobs is based on dynamic, resource- 
driven priorities. 

The major goal of memory scheduling is to implement the working set model of memory 
management. 

I/O scheduling is done implicitly through the mechanism of resource-driven priorities. 
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Part VII 

Type Manager Services 



This part of the BUN™ I OS Guide shows you how to build type managers, software modules 
that implement new object types and their attributes. 

The chapters in this part are: 

Understanding Objects 

Explains objects and their characteristics. 

Understanding Memory Management 

Explains how the OS manages memory. 

Building a Type Manager 

Shows you how to design and implement a simple type manager. 

Using Type Attributes 

Shows you how to define and implement type-specific attributes, packages 
or data structures supported by multiple object types. 

Managing Active Memory 

Shows you how to control object allocation and deallocation, and control 
object reclamation via garbage collection. 

Building Type Managers for Stored Objects 

Shows you how to design and implement type managers for objects stored 
on disk. 

Understanding System Configuration 

TM 

Explains how a BiiN node is configured as a collection of type managers 
that have configuration requirements. Each such type manager implements 
the configuration attribute. 

Type Manager Services contains the following services and packages: 

TM object service: 

Countable_Object_Mgt 

Global_SRO_Defs 

Lifetime_Control 

PSM_Trusted_Attributes 

SRO_Mgt 

Unsafe_Object_Mgt 

TM transaction service: 

Local_Transaction_Def s 

Local_Transaction_Mgt 

TM_Transaction_Mgt 

TM concurrent programming service: 

Job_Resource_Reclamation 

Port_Mgt 

Typemgr_Support 

Unsafe_Port_Mgt 

Unsafe_Semaphore_Mgt 

configuration service: 

Configuration 



Part VII Overview 



PRELIMINARY 



custom naming service: 

Custorai zed_Name_Mgt 

Link_Mgt 

Standalone_Directory_Mgt 

backup service: 

Backup_Support not implemented in this release 
Trusted_Log_Mgt not implemented in this release 
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This chapter explains concepts related to objects and access descriptors. You can find most of 
this information elsewhere in the BiiN™ document set, but you would have to look in many 
different places. This chapter is the place where all pieces are brought together, so that you can 
understand the building blocks of the BiiN™ architecture. 

The BiiN™ system has an object-oriented architecture; objects are the building blocks of the 
system. This is not the first system based on object-oriented programming. The difference 
between the BiiN™ system and other systems is the rigor with which object-orientation is 
implemented. 

VII-1.1 Why Use Objects? 

Objects are used in the BiiN™ system for the following reasons: 

• Data abstraction 

• Memory protection 

• Secure and dynamic memory management 

• Support for complex and extensible applications 

• Uniform storage model for permanent and volatile memory 

• Distributed storage model. 

Each point above will be briefly explained in the following sections. 

VIM. 1.1 Data Abstraction 

In most cases your program will not be concerned with the inner workings of objects. An 
object appears like a black box to the programmer. The box has "jacks" and "buttons". As 
you press certain buttons the box takes things from the input jacks and sends something to its 
output jacks. Or the box performs some other operation. The two important points in the anal- 
ogy are: 

• The box's buttons do certain things and those things only. 

• How the box performs its operations or how it looks on the inside is unknown. (See Figure 
VII-1-1) 
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Figure VII-1-1. An Object as a Black Box 



Objects present a well defined outside view. That means that their functionality is defined "on 
their front panel". How the object works is hidden from view. Data abstraction of this type has 
two advantages: 

• A programmer can use an object without having to know what goes on inside just as you 
may use a television set without having studied the intricacies of electromagnetism. 

• The inside of an object may be altered without affecting programs that depend on the 
outside of the object 

You can compare objects to Ada packages. The outside view of an object corresponds to the 
specification of the package. The representation of the object corresponds to the body of the 
package. 



VIM .1.2 Memory Protection 



Objects are the unit of protection in a BiiN system. The memory of a BiiN system should 
not be viewed as an array of bytes but as a network of objects. The way the objects are 
connected can change at any time as the system runs. Each connection consists of a pointer 
called the object index and a list of access rights. These connections are called access 
descriptors (AD). The both provide and limit access. Connections can be made based on a 

TM 

strict "need to know" basis. Connections can only be made (ADs created) by the BnN 
Operating System. The BiiN™ Operating System uses special hardware instructions to manipu- 
late ADs. Every access to memory involves checking 

• that an AD presented is a valid AD, 

• that an AD has proper access rights, 

• that the reference falls entirely within the referenced object. 

While objects are protected by ADs, ADs are protected by the hardware. Special instructions 
are required to create and copy ADs. Nobody, not even the operating system, can circumvent 
this protection mechanism. 
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VIM .1.3 Secure and Dynamic Memory Management 

Objects are dynamic. They can be of any size from zero to four Giga bytes. They can be 
dynamically created, resized, and destroyed. Unneeded objects are automatically removed. For 
example you can create an object, change its size as many times as you want over the lifetime 
of the object and then simply abandon it. The operating system will pick up after you. Long 
running or very large programs can also explicitly control garbage collection. This relieves the 
operating system considerably. 

VIM .1.4 Support for Complex and Extensible Applications 

Complex programs can never be entirely free of bugs. In a complex system a constant concern 
is that one program module not corrupt another. This problem is particularly hard to handle in 
conventional architectures: The instructions or data that have been corrupted may not even be 
related to the corrupting module. 

This is a particularly acute problem when you want to extend important, sensitive, and com- 
plex applications, or maybe the OS itself. The traditional solution to the problem is to adopt a 
two-view scheme. In a two-view scheme the address space is divided into two levels, one level 
reserved for the operating system, and one level for the user. The interaction between the two 
levels is severely limited. The two-view scheme restricts functionality. 

If address space is shared between user and operating system one risks major breakdowns of 
the combined system. 

In the object-oriented architecture of a BiiN™ system addressing errors are confined to their 
origin: A wrong address will also always be an invalid address. This is done with a multiple- 
view scheme. Every application program, every system routine, in fact, ever job runs in its 
own protected address space. All jobs execute at the same level. The important ingredient in 
the multiple-view scheme is an efficient call/return mechanism that allows communication 
between protected address spaces. 

For example, extensions to the OS run at the same level as the OS and are therefore able to use 
its full functionality. The same applies to applications. Any program can be easily extended 
without compromising reliability of the original program. 

VIM. 1.5 Uniform Storage Model for Permanent and Volatile Memory 

The BiiN™ system extends its model of protection and its object-oriented architecture to per- 
manent storage. Objects in permanent memory (such as magnetic disks) are called passive 
objects. Objects in volatile memory are termed active objects. Permanent memory is termed 
passive store. There can be multiple active versions of an object but only one passive version 
at any time. In order to read the contents of an object or to write an object, the object has to be 
activated first When a change to an object should become permanent, the object will be 
passivated. That means that either a new passive object will be created, or an existing passive 
version of the object will be updated. When multiple active versions of an object are present, 
the BiiN™ Operating System ensures that obsolete active versions cannot corrupt the passive 
object. 
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VIM .1.6 Distributed Storage Model 

TM 

Passive store is distributed - spread over multiple BiiN nodes and transparently accessible 
from any node. One can view passive store as the glue that holds a distributed BiiN™ system 
together. Passive store is divided into volume sets. Passive objects are stored on volume sets. 
Along with each passive object, a master AD is stored on the same volume set. That passive 
AD contains a unique identifier (UID), unique for all times and on all BiiN™ nodes. Even if a 
disk is moved to another BiiN™ node or BiiN™ system, the passive objects stored on that disk 
will still be uniquely identified. 



VII-1.2 How Objects Work 



In the previous section you have learned what objects are, namely typed and protected memory 

TM 

segments. In this section you will learn how objects function in the BiiN architecture. 

An object is characterized by a number of properties such as size, lifetime, type and a list of 
attributes. Objects can also be active or passive. In the following sections you will leam about 
these properties in more detail. 



VIM .2.1 Object Sizes 



Objects can have sizes ranging from zero to four Giga bytes. Object sizes are rounded. (How 
object sizes are rounded is explained in chapter VII-5.) Objects can be created resized and 
destroyed at runtime (see Figure VII- 1-2). 
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Figure VII-1-2. An Object Can be Resized 



VIM .2.2 Types 



You probably know what typing is from programming languages such as Ada or Pascal. In one 
sense object types in a BiiN™ system are no different than data types in Ada. Since most of the 
BiiN™ Operating System is written in BiiN™ Ada, object types are implemented to a certain 
degree as Ada types. In another sense object types are very different from Ada types. Data in 
Ada is typed only at compile-time while objects are also typed at runtime. Whenever a 
software module attempts an operation on an object in a BiiN™ system, the OS first checks 
whether the operation is allowed for the object. While you can get around compile-time typing 
by using conversion functions or type overlays, there is no way to circumvent runtime typing 
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There are a number of predefined system types such as disk, file Job , or program. (For a 
complete list of system types refer to the Appendix of the BUN™ /OS Reference Manual.) On 
top, there is one peculiar type of objects called generic objects. Generic objects are untyped 
although, strictly speaking, they have a defined type, the so-called generic type. 

You are not limited to the system types. Just as in Ada, you can define your own types and 
implement them on the system. 

Object typing is complete and pervasive, more so than typing in programming languages. 
There are no backdoors that let you bypass the typing mechanisms. 



VIM .2.3 Object Protection 



Typing protects an object from operations that are not defined for the object. There is another 
mechanism that protects the contents of the entire address space. This protection is provided by 
protected pointers called access descriptors (AD). As the name indicates, ADs provide access 
to objects. At the same time ADs limit access. Protection by ADs is complete. No object can 
be accessed without an AD. You can go so far as to identify an AD with the object. 

Figure VII- 1-3 illustrates the relationship between an object and an AD in a simplified way. 



Access Descriptor 






Pointer 


Rights 








Object 













Figure VII-1-3. Object and Access Descriptor 



VIM .2.4 Attributes 



While typing of objects serves two functions, namely protection and data abstraction, the same 
applies to attributes. Attributes are the means by which the prime capability of objects is 
realized; objects describe the operations that can be performed on them. An attribute is itself an 
object that acts as a label. The label typically describes an operation such as 
Byte_Stream_AM . ops . Read. All objects that allow Byte_Stream_AM . ops . Read 
carry a reference to this attribute. The mechanism works like this: 

Objects have an attribute list that consists of <attrib-ID,attrib-value> pairs. The attribute-ID 
part references the attribute while the attribute value is typically an AD to a routine that imple- 
ments the operation for the type. 
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All attributes contained in a particular object's attribute list apply to that object. In addition to 
these attributes an object inherits all attributes defined for its type. Those type-specific at- 
tributes are defined in the object's TDO. 

For an example and an illustration of these dependencies see Figure VII- 1-4. 
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Figure VII-1-4. How Attributes Work 



In Figure VII-1-4 there are two objects, a spreadsheet object and a document object. Both have 
inherited the attribute "printable" from their respective TDOs: The attribute lists of the 
two TDOs contain a reference to the same attribute "printable". The attribute values 
however are different: The document TDO has an AD to a package that implements printing 
of documents (named Print_Document) while the spreadsheet TDO has an AD to a 
package that is capable of printing spreadsheets (named Print_Spreadsheet). 

Before concluding this section on attributes we shall briefly touch upon the general protocol of 



how attributes are implemented in a BiiN system. 
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Generally an implementor will establish a 1:1 correspondence between Ada attribute packages 
and attributes. There will be one attribute package for each attribute. The attribute package 
only contains subprograms and no other declarations. However, an attribute package can be 
nested inside another package that provides data declarations and subprograms common to all 
types. An attribute package must also have the Ada package_type pragma. This marks the 
package as an attribute package and binds it to the attribute ID, which is identified by its 
pathname. The body of an attribute package is empty. 

As the next step, the implementor of an attribute will define various instances of the attribute 
package. These instances are the type- or object-specific implementations of the attribute pack- 
age. In Figure VII-1-4 Print_Spreadsheet and Print_Document are such instances 
of one attribute package Print. 

Instances have their own package specifications which all match the specification of the at- 
tribute package. The instances are bound to the attribute package by the package_value 
Ada pragma. Every instance has its own specific body and runs in its own domain. Instances 
cannot be merged into one domain with other packages. 

VIM .2.5 The Inside View of an Object 

After having learned about the characteristics of an object, we proceed to explore how these 
concepts are implemented in the memory of a BiiN™ system. Figure VII- 1-5 illustrates the 
inside view of an object. We have already learned about objects and ADs. Here we see that 
there are some more details to the picture: 
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Figure VII-1-5. Objects Are Typed and Protected 



An object consists of two parts, the object descriptor (OD) and the object's representation. 
When we talk of the size of an object, we refer to the size of its representation. The represen- 
tation holds the contents of the object. The object descriptor on the other hand holds important 
information about the object, such as the physical address of its representation and its size. As 
Figure VII-1-5 indicates, an AD to an object points to the object descriptor not the object's 

TM 

representation. All object descriptors on one BiiN node are held in a one place, the object 
table. An object's representation may be moved around in memory by the BiiN™ Operating 
System but the object descriptor always stays in the same place. 

The object's type is defined in the object descriptor by an AD stored there that points to a type 
definition object (TDO). There is one TDO for each distinct type. That means that two objects 
have the same type if their object descriptors reference the same TDO. 

This model of objects with its two parts, object descriptor and object representation allows for 
a peculiar object, an object of length zero. Such an object has no representation and therefore 
really has zero length. This means that all information that pertains to the object is contained in 
the object descriptor. Objects of length zero are very useful as unforgeable identifiers. They 
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can be compared to license plate numbers. The significance of a license plate number is not the 
information contained in it but the fact that it is different from all other license plate numbers. 



VIM .3 Address Space Protection 



As software grows more and more complex, bugs become impossible to eradicate. No software 
engineer, nor any company can guarantee that their software products will not fail under any 
circumstances. Such software failures can have disastrous results as processors pervade our 
daily lives. It has therefore become imperative that failures be detected at their origins and that 
their influence be confined. 

The most dangerous types of errors are addressing mistakes. By making such a mistake, a 
routine can corrupt data or programs anywhere in a computer's memory. Such a mistake may 
go unnoticed for a while until the corrupted data or programs are used. When the fault is 
finally discovered, it is almost impossible to locate its origins and prevent it from happening 
again. 

Address space protection should not be monolithic as different programs require different 
levels of protection. A well tested routine running as a separate process would only suffer in 
performance if it had to drag along the same protection mechanisms that are needed for a 
recently implemented extension to the operating system. 

The BiiN™ architecture provides a flexible and efficient protection scheme that addresses this 
problem. The unit of protection in a BiiN™ system is the object An object is protected on three 
levels. (For an illustration, see Figure VII- 1-6.) 
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Figure VH-1-6. Threefold object protection 



The entire memory of a BiiN system is organized in terms of objects. Objects can only be 
accessed by protected pointers, the access descriptors. An AD contains the information where 
the object it references is stored. But the AD limits the access to the object by way of access 
rights that are stored in it. Access descriptors are manipulated in controlled ways by the 
hardware. If a routine attempts to manipulate an AD, such as changing the address or tamper- 
ing with the rights, the AD will automatically be invalidated. This is the basic protection mat 
applies to all objects in a system. 

ADs are given out on a strict * 'need to know" basis. Any subroutine therefore has access only 
to the objects that it needs to reference. Thus the set of objects accessible to any one call is 
strictly controlled. In Figure VII- 1-6, this set is represented by the second outermost circle. 

Objects are further protected by typing. Operations are tied to object types; an implementor 
defines what operations are permissible. This level of protection is represented in Figure 
VII- 1-6 by the third outermost circle. 

Finally the strictest protection is provided by the type manager model. A type manager is a 
routine that implements all operations on a certain type. Any routine that wants to perform an 
operation on the object protected by a type manager has to do so using a call to the object's 
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type manager. This mechanism strongly confines any error that may occur in an operation on 
an object: Only the type manager can physically get to its objects. And only it is responsible 
for the objects' integrity. This level of protection is represented in Figure VII- 1-6 by the inner- 
most circle. 

TM 

In a BiiN system not all levels of protection have to be used at all times. Trusted routines can 
trade in protection for performance. 

VIM .3.1 Access Descriptors 

TM 

Previously, we have characterized the memory of a BiiN system as a network of objects and 
access desscriptors as connections in the network. Access descriptor are protected pointers; 
pointers, because they contain a physical address; protected, because only the BiiN™ Operating 
System can create ADs. You may even identify an AD with the object because there is no way 
to get to the object except by AD. 

Words on a BiiN™ system are 33 bits long. The 33 rd bit of every word is a tag bit. If the tag bit 
is set, the hardware recognizes the word to be an AD. The information in an AD, address and 
rights together is 32 bits long. Figure VII- 1-7 shows an AD. 
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Figure VII-1-7. An Access Descriptor 



The first 26 bits contain the object index, then a local bit follows, and the next 5 bits are the 
rights. (There can be 2 26 different objects on one BiiN™ node at any time.) 

There are five rights, three type rights and two representation rights. Type rights, as their name 
indicates are specific to object types. Their names may vary with the types they apply to. 
However, there is a naming convention for those three rights: They are called use, modify and 
control. In the case of a device, they may be renamed to read, write and control and in the case 
of a directory to List, and Store. There are no control rights in the case of directories. 
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Type rights give access to an object's logical structure. For example, if you have modify rights 
to a file you may write to this file record by record. Representation rights are different. There 
are read and write representation rights. They give access to an object's physical layout in 
memory. In the type manager model no routines are granted representation rights except the 
type manager. (See Figure VII- 1 -8) 
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Figure \H-l-8. A Type Manager Makes the Object Appear as a Black Box 

It is important to understand the difference between type rights and representation rights. For 
example, take read rights and read representation rights for a file. A file may have a very 
complicated layout in memory. It may sometimes be moved around by the operating system 
and it does not even have to be stored in a contiguous way. Having read rights you would 
never be aware of the way the file exists in memory. You could read the logical content of the 
file, however, and you could copy it. Having read representation rights to the file, on the other 
hand, you could read it bit by bit and find out precisely how it is stored in memory. Here we 
can go back to our black box analogy; type rights give you access to a black box's front panel. 
Representation rights are like a mechanic's license. They allow you to take a screwdriver, open 
up the box, and dig around inside. 

VIM .3.2 Type Managers 

Type Managers provide the strongest protection in a BiiN™ system. 

That protection is provided by the following mechanism: Any operation on an object protected 
by a type manager is a call to the object's type manager. The type manager is the only routine 
that operates directly on objects of its type: Only the type manager can create new instances of 
its type and only the type manager can remove those instances. 

To use an analogy: In rare book libraries, users are not allowed into the stacks. Type managers 
act like librarians in such a library. Users of the library fill out request cards, and the librarians 
bring the books out of the stacks. 

Type managers implement two paradigms of the BiiN™ architecture: 
• Error confinement 
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• Independence of implementation details. 

A well defined functionality is associated with objects of a given type. This functionality is 
provided by one module, the type manager. The type manager concept hides implementation 
details in the the type manager module and confines all errors to that same module. 

As a new type is created, the system returns an AD for the type's TDO. That AD has amplify 
and create rights. It will be confined to the new type's type manager. A routine may now call 
the type manager and pass an AD with certain type rights to it The type manager will use its 
AD to the TDO as a key and add representation rights to the passed AD. After performing the 
requested operation, the type manager strips off the representation rights and returns the AD to 
the calling program. By definition any routine that holds an AD with Create and Amplify 
rights to a TDO is a type manager for that type. ADs with representation rights should never be 
passed outside a type manager. There is is one exception to mis rule; the rule does not apply to 
generic objects. 

Generic objects are untyped in the sense that there is no type manager for generic objects. The 
operating system functions as the type manager for generic objects and gives out ADs with 
representation rights. Generic objects, however, are the only objects for which there are ADs 
with representation rights outside a type manager. 

Generic objects are used whenever an untyped memory segment is needed. Representation 
rights are needed to write an untyped memory segment. 



VIM .3.3 Domains 



Domains provide protected address space for program execution. A domain is represented by 
an object of type domain. How a program is split up over different domains is specified at 
link-time. The modules that make up a program may be linked into separate domains or some 
or all may be merged into one single domain. When calling a routine in a different domain 
address space is switched to the called routine's domain. Upon return, address space is 
switched back to the calling domain. The inter-domain calling mechnanism mutually protects 
caller and callee. 

A separate stack may be associated with any set of domains. A set of domains that share one 
stack is called a subsystem. Subsystems are completely isolated from one another. The address 
space of a subsystem looks very much like an independent computer all by itself. 

Figure VII- 1-9 illustrates the details of a domain object. 
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Figure VII- 1-9. Linear Address Space and Domain 



A domain holds ADs to the static data object, the instruction object, a subsystem ID, and an 
object reserved for use by the BiiN™ Operating System. 

The static data object contains data that cannot be referenced outside the current domain. If a 
program has only one domain, the static data object contains all variables with global lifetime. 
The static data object also contains ADs to other domains whose external procedures can be 
called from this domain. 

The instruction object contains the code for all subprograms defined in this domain. 

The subsystem ID references a local stack object that contains parameters, local variables and 
housekeeping information used in subprogram calls. All domains in one subsystem and one job 
share a stack object. If you want to have a process executing with its own stack you have to put 
the process in its own subsystem. 

There is a performance penalty attached to inter-domain calls. Only those modules that need 
the added protection should therefore be linked into separate domains. 



VIM .4 Passive Objects 



We have mentioned before that there can be active and passive versions of an object. Most of 
our previous discussion applied to active objects. Although passive objects are very similar to 
active objects, there are a number of differences that you will need to understand. This section 
explains how objects act as the building blocks of passive store, a BiiN™ system's permanent 
memory. 
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VII-1.4.1 Active Memory 



Active memory is the collection of objects in virtual memory on a particular BiiN node. An 
object can have versions in both active memory and passive store (Figure VII- 1-10). 
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Figure VII-1-10. An Object's Active and Passive Version 



Only active versions can be directly read or written. Reading or writing an object with no 
active version causes the object to be activated. Objects are activated on demand, trans- 
parently, just as pages of virtual memory are swapped in when needed. Both operations are 
invisible to your application. Changing an object's active version does not change the object's 
passive version. An explicit update call is needed to copy an object's active version to its 
passive version. 



VIM .4.2 Passive Store 



TM 

While active memory is entirely part of one BiiN node, passive store is completely dis- 
tributed in a BiiN™ system. Passive store is the glue that holds a distributed BiiN™ system 
together. (See Figure VII- 1-11) 
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Figure VII-1-11. Passive Store Unifies All Nodes in a BiiN System. 



TM 

Passive store wraps around an indefinite number of disks in a distributed BiiN system. Logi- 
cally it is divided up into volume sets. Volume sets are associated with individual nodes. 
However, that association is transparent to the user. 



VIM .4.3 Passive ADs 



When an object is first stored, passive store creates a passive AD for the object. A passive AD 
is a much bigger entity than an active AD. The reason is that a passive AD is a unique refer- 
ence on an entire distributed system, while an active AD is valid only on a particular BiiN™ 
node. 

Whenever an AD crosses the boundary between active and passive store or between different 
nodes of a distributed system, it has to be converted from its active to its passive form. 

Just as there can be multiple active ADs to one object, there may be more than one passive AD 
to an object. (There may also be active ADs to passive objects.) One of the passive ADs is the 
master AD. All other passive ADs are called alias ADs. The master AD plays a crucial role. 
An object cannot be stored until a master AD exists. If there is no longer any master AD for an 
object that object will be removed. There are the following exceptions to that rule: 

• If the master AD is stored in a directory and other directory entries on the same volume set 
reference the object. One of these alias ADs then becomes the new master AD. 

• If the master AD is stored in another object and other ADs in that object reference the 
object One of those alias ADs then becomes the new master AD. 
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VII-1.4.4 Passive Store Protection - Authority Lists 

Naming of and references to passive objects are slightly different than for active objects. The 
reason for this is simple: An AD once given out is irrevocable. That means that rights once 
granted by giving out an appropriate AD cannot be taken back. Generally this poses no 
problem in active memory since usually active objects only exist for short time periods. Ob- 
jects on disk, however, exist indefinitely. 

The model for protecting objects in passive store is different from the address space protection 
provided by ADs in active memory. Protection requirements are different for passive objects 
than for active objects. 

In active memory a program should execute as much as possible in a secluded cell. Thus the 
segment of memory that can be affected by an erring program is kept to a minimum size. 

This protection philosophy is inadequate for passive store for two reasons. 

• Passive store is distributed. The view that any one job has of passive store should as wide 
as possible without opening up protection holes. 

• Objects in passive store exist indefinitely. Information of who may access an object stays 
with the object. This allows the owner of the object to alter access over the lifetime of the 
object. (The philosophy behind active memory protection is to attach the information of 
who may access an object not to the object but to the requesting job. In this model it is 
difficult to revoke access once it has been granted.) 

The difference explained in the second point above can be likened to the difference between a 
key lock and a combination lock. A key will always open the key lock just as an AD will 
always grant access to its object. But a combination can be made invalid when the lock is reset 

The protection provided for stored objects is based on the concept of an authority list. An 
authority list consists of <ID, Type Rights> pairs. When an object is first stored, an authority 
list can be specified by the storing process. If no authority list is given, the object will receive 
the default authority list of the directory in which it is stored. If there is no default authority list 
for the directory, the object receives the storing process's default authority list defined in the 
process globals. A passive object may also have no authority list. 

An authority list is a vehicle for granting access to different users, user groups and programs. 
The owner can grant or revoke access at any time by specifying a new authority list. (Figure 
VII-1-12 shows how authority lists fit into the organization of passive store.) 
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Directory 




Figure VH-1-12. A Stored Object 



Authority lists define access in two operations and for both in slightly different ways: Firstly, 
when a passive object is explicitly retrieved, the retrieving job's list of IDs is compared to the 
authority list and an AD is returned with the combined rights of all matching IDs. Secondly, 
when an AD is transparently activated, the activating process's ID list is checked against the 
authority list of the container and against the authority list associated with the AD proper. This 
ensures that stored ADs cannot be activated unless their rights are current. Should rights have 
been revoked since the AD was given out, the AD will loose those rights when it is activated. 
Note that an object's owner always has access to the object even if his ID does not appear in 
the authority list For more details, see Chapter III-3. 



VIM .4.5 IDs 



As you have seen in the previous section IDs are central to the protection concept used for 
passive store. It is therefore necessary to tell some more details about IDs. 

IDs are maintained centrally in a a BiiN™ system, namely in the Clearinghouse. To get back to 
our previous example of the two different locks: Each ID is like the combination for a com- 
bination lock. (The analogy is a little bit weak at this point since combination locks usually 
only have one combination. Let's however disregard this for the moment and assume that there 
are combination locks that open by more than one combination.) 

As IDs are the keys to stored objects, they in turn have to be protected. This is achieved by 
way of protection sets and passwords. Protection sets are similar to authority lists. They consist 
of <ID, Rights> pairs. The two rights defined for IDs arc portray and control. The portray 
right grants the holder permission to add this ID to an ID list. Control rights allow the holder 
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to alter the password on an ID. By specifying the proper password, one can obtain an AD to an 
ID with portray rights. 

VIM .4.6 Updating Stored Objects 

Most calls to passive store are transaction-oriented. In particular, updates on stored objects 
can be included in a transaction. (A transaction ensures that all the operations included in it are 
executed as a unit: Either all the operations inside a transaction will be executed or none of 
them.) With the help of a transaction, you can prevent incomplete updates. Including calls to 
passive store in a transaction also prevents clashes between multiple jobs attempting an opera- 
tion on the object. While the older of two transactions executes, it reserves the object. The 
younger transaction simply waits until the older one finishes. 

Another problem arises when multiple active versions of an object exist. An obsolete active 
version could be used to update the passive version. Two situations can arise: 

Multiple Activation Model: 

There are multiple active versions of a passive object. Passive store keeps 
track of all active versions and refuses updates from obsolete versions. 

Single Activation Model: 

A single activation object is only activated in one home job. Other jobs 
that activate the object receive a token active version of the object called 
homomorph. Jobs that want to update the object have to communicate with 
the home job. For all operations on the object the job communicates with 
the home job of the object. 

Both models are supported by the BiiN™ system. Depending on the needs of an application, the 
programmer can decide which one to use. In this context it is only important to note how 
updates are handled in these two models. 

VIM .5 Summary 

After having read this chapter you should understand the following concepts: 

TM 

All information in a BiiN system is contained in objects. 

Objects are typed and protected memory segments. 

Objects are the unit of protection. 

Access descriptors are protected pointers. Objects can only be accessed with access 
descriptors. 

Objects can be dynamically allocated, resized, and destroyed. 

Objects may "know" what operations can be performed on them and how. 

Objects can have passive and active versions. 

Objects can be local to a job or global to a particular node. 

Passive objects are uniquely identified on all BiiN nodes and for all time. 

TM 

Access descriptors can pass freely between the nodes of a BiiN system. 

If you understand all these concepts, you can go on to the next chapter which explains memory 
management. 
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Objects are abstract constructs. Just as you cannot understand the concept of an automobile by 
studying metallurgy, you cannot understand objects by looking at their representation in 
memory. However, if you want to design a car, you will probably have to understand some 

TM 

metallurgy. Similarly, you will have to understand how memory is managed in a BiiN node if 
you are going to do some system programming, because objects are "made out of memory". 

This chapter describes how a BiiN™ node manages its memory. It covers the underlying con- 
cepts of virtual memory and of the allocation and deallocation of objects. It discusses how 
objects are laid out in memory, when they can be moved around by the system and when not. 
And finally, it shows the forms of addresses in a a BiiN™ system and how they are resolved. 
This chapter does not give a detailed description of passive store. However, where passive 
store concepts are relevant to active memory management, they will be explained briefly. This 
chapter builds on the previous chapter (Chapter VII- 1). You should either read that chapter or 
have a good understanding of objects and how they function in the BiiN™ architecture, before 
reading this chapter. 

VII-2.1 Physical Memory Organization 

Physical memory consists of a node's RAM and all disks that are mounted on the node. Physi- 
cal memory is divided into active memory and passive store. Figure VII-2-1 shows how 
memory is organized in a BiiN™ system. 
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Active Memory 




Active Memory 
Figure VII-2-1. The Organization of Memory in a BiiN™ sytem 

Active memory, as its name indicates, is the immediate "working space" of the processor. 
Active memory is also volatile. Its contents are lost whenever the system is turned off. Passive 
store on the other hand is permanent storage. Its contents cannot be lost unless a disk is 
damaged. (See Figure VII-2-2.) 
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Figure VII-2-2. Passive Store 



The memory pool on all disks of a node is partitioned into volume sets. Volume sets in turn 
consist of from 1 to 254 volumes. A volume set can span multiple disks. A single volume 
always resides on one particular disk. However, there can be more than one volume on a single 
disk. A volume set can be either a swapping volume set in which case it is part of the active 
memory, or a filing volume set and part of passive store. Swapping volume sets are invisible to 
the user. They appear as part of active memory, and from a user's point of view, the memory in 
a swapping volume set looks identical to the RAM. 

The physical memory that underlies all other memory is partitioned into 4K byte page frames. 
Each page frame is uniquely identified by a page number. (See Figure VII-2-3.) A page frame 
is simply an empty page. A page is the unit of abstraction of memory management. The 
smallest unit that memory management recognizes is 64 bytes. 
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Figure VII-2-3. Physical Memory is Divided into Pages 



Private to memory management is a central page frame table (PFT) where information about 
the contents of all page frames is stored. Since a single page frame may contain different 
information as time progresses, the contents of the page frame table entry will change as well. 
(There is a parallel here between physical and logical memory organization: Object table and 
page frame table and object descriptor (object table entry) and page frame table entry play 
similar roles. An important difference between the two is that the object table is recognized by 
the hardware, while the page frame table is purely a software concept.) 
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VII-2.2 Virtual Memory Organization 

Active memory is organized according to the virtual memory concept. This means, the part of 
memory that is directly accessible to the node may span parts or all of the node's RAM and 
mass storage devices such as disk drives as well. The processor's total physical address space 
is 2 32 bytes. (That is about 4G bytes.) (See Figure VII-2-4.) The total virtual address space 
permissible is 2 58 bytes, consisting of 2 26 objects and 2 32 bytes per object The virtual memory 
concept frees the system from the limitations imposed by relativley scarce primary memory. 
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Figure VII-2-4. Active Memory Uses Both RAM and Disk. 

Virtual memory management takes advantage of the fact that the entire address space of the 
node is not used simultaneously at all times. The processor can only directly address pages that 
are available in RAM. This part of memory is called primary memory. Memory management 
moves pages in and out of primary memory in such a way that the user has the illusion that all 
the information is contained in primary memory. Pages are swapped in as they are referenced 
and swapped out when they are no longer needed. A page is either accessible or not. If the 
page is accessible, it means, the page resides in primary memory and the process can get to it 
directly. If the page is not accessible, memory management retrieves it from its location in 
secondary memory (on disk, in the swapping volume set) and places it in primary memory. 

There is a common page pool that is a list of free pages in primary memory. When a job 
requests space in RAM, pages from the common page pool are allocated to it. When a page 
that is not altered is returned to the common page pool, then, if a process references the page, it 
can be reclaimed from the pool, thereby avoiding a swap-in. In essence, the common page pool 
represents a cache of pages in the swapping volume set If a page is not available in the com- 
mon page pool, it is swapped in from disk. That means, its contents is copied into a newly 
allocated page frame. 



VII-2.2.1 The Object Table 



Physical memory is organized in terms of pages. On the other hand logical organization of 
memory is in terms of objects. The page frame table (PFT) centralizes important information 
about pages. Analogous to the PFT in the organization of physical memory is the object table 
in the logical organization of memory. (The object table is a hardware defined and hardware 
recognized data structure, while the page frame table is a purely software defined data 
structure.) The PFT consists of page frame table entries, and the object table consists of object 
descriptors. (See Figure VII-2-6.) 
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Figure VII-2-5. The Object Table and Object Based Adress Translation 

Objects can only be referenced by access descriptors (ADs). There can be a multitude of ADs 
to any single object. It is necessary to have one single place where important information about 
the object is stored, such as its physical address. Otherwise all ADs to the object would have to 
be updated if some of the information changes. For tibds reason, there is exactly one object table 
per node. 
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VII-2.2.2 Object-Based Address Translation 



T TM 



Figure VII-2-5 also illustrates the addressing mechanism. The BiiN system recognizes two 
types of addresses, linear and virtual addresses. Linear addressing is faster than virtual ad- 
dressing, but is restricted to a single domain. Linear addresses are used for programs that 
execute entirely inside a linear address space. This would typically be the case with 
FORTRAN and Pascal programs. In order to access arbitrary objects in the system you have to 
use virtual addresses. Figure VII-2-6 shows a valid virtual address. 
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Figure VII-2-6. A Valid Virtual Address 



Virtual addressing is an object-based addressing scheme. Figure VII-2-5 illustrates the virtual 
addressing scheme. A virtual address consists of two parts, an AD to the object that contains 
the field that you want to access, and an offset into the object that specifies where the field is 
located inside the object. A linear address is an offset by itself, witout an AD. 

As mentioned previously, the AD does not reference the object directly but rather it refers to 
the object descriptor in the object table. The object descriptor holds the physical address of the 
object. 

VII-2.2.3 Storage Resource Object 

There is one storage resource object (SRO) associated with each job. It represents a pool of 
storage local to the job and all its processes. When an SRO is first created, a certain storage 
claim is assigned to it. As storage is allocated from the SRO the storage claim is debited, and if 
storage that had been allocated from the SRO is deallocated, the claim is credited with the 
proper amount. A job's local SRO is a global object which is removed once its controlling job 
terminates. In addition to local SROs there are two global SROs for each BiiN™ node, one 
controlling normal memory allocation and the other one controlling^zen memory allocation. 
Global SROs can only be referenced by administrative users and trusted type managers. 
Global SROs have unlimited storage claims. SROs are active-only objects: That means that 
SROs cannot be passivated. (For a discussion of normal and frozen memory, see section 
VII-2.2.5.) Figure VII-2-7 illustrates SROs in a node's virtual memory. 



Understanding Memory Management VII-2-7 



PRELIMINARY 



Node 




Global Address 


Space 


/Job A's\ / 


Job B's\ 


I Address 1 ( 


Address 1 


\ Space J \ 


Space J 



Local SRO's 
Figure VII-2-7. Active Virtual Memory, Jobs, Nodes and SROs 



VII-2.2.4 Object Representations 

An object's representation is an area in virtual memory that holds the contents of the object. 
An object's representation has a certain size that can range from to 2 32 bytes. However, 
object sizes are rounded depending on the size of the object: 

1 . If size - bytes, or if the object is a semaphore, then the object' s representation is 
entirely contained within the object descriptor. These objects are called embedded objects. 

2. If < size <- 4 K bytes, then s i z e is rounded up to the next multiple of 64 bytes. 
These objects are called simple objects. 

3. If4K < size <- 4M bytes, then size is rounded up to the next multiple of 4 Kbytes. 
These objects are called paged objects. 

4. If4M < size <= 4G bytes, then size is rounded up to the next multiple of 4M bytes. 
These objects are called bipaged objects. 

The reason for the rounding outlined above stems from the paged structure of the underlying 
physical memory. The following paragraph outlines the mechanism. For more details refer to 
BUN™ Systems CPU Architecture Reference Manual. 

Simple objects can share a page frame with other simple objects. If an object's size is equal to 
4K bytes, it will occupy a page all by itself. In the case of a paged object the object descriptor 
references a page table (PT). A page table is simply a list of all pages that are part of the 
object's representation. The page table is located on a page frame itself, possibly together with 
other object's page tables. If a paged object's size is equal to 4M bytes, the page table will 
occupy an entire page by itself. The object descriptor of a bipaged object references a page 
table directory (FTD). This is a list of page tables which in turn are lists of page frames. 
Instead of having one very long page table there are two levels of page tables (hence the name 
bipaged objects) - many 4K page tables, and one level up, a table of those page tables. In the 
extreme case of an object occupying 4G bytes, the page table directory itself occupies an entire 
page. 
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The object table is a paged or bipaged object. It is handed out in units of single pages which 
can contain up to 256 object descriptors. Whenever possible, the object table is kept down to a 
paged object to keep down address translation times. Only when necessary will the object table 
become bipaged. 

VII-2.2.5 Frozen and Normal Memory Types 

In certain cases, such as real-time or time-critical applications the virtual memory mechanism 
of swapping pages in and out of primary memory may cost too much time. Upon request, a job 
can run in frozen memory. The job's SRO will then allocate objects that will not be moved 
between primary and secondary memory but will reside entirely within primary memory. A 
local SRO that has a frozen memory type has an infinite storage claim. The designer of the 
application will have to take care that there is sufficient primary memory to run the program. 
Furthermore, in order for all pages to be allocated before the program runs, the user must have 
allocate-on-creation rights for the SRO. 

Most other programs will run in normal memory. They have an SRO with a normal memory 
type. The SRO than has a given fixed storage claim. 

VII-2.3 Different Allocation Policies 

Two policies are used when paged objects are allocated in primary memory. The standard 
policy for SROs with a normal memory type is allocate-on-reference: First, only the page table 
directory is allocated for a bipaged object and the page table of a simply paged object. Second 
level page tables of bipaged objects and pages of paged objects are physically allocated in 
memory only when they are directly referenced. 

The second policy, called allocate-on-creation, is reserved for SROs with frozen memory type. 
The SRO also needs to have allocate-on-creation-rights. Allocate-on-creation can be explicitly 
enabled and disabled for such an SRO. If an SRO with allocate-on-creation enabled allocates 
an object, the entire representation of the object will be allocated. This technique is useful for 
time-critical and real-time applications. 



VII-2.4 Object Lifetimes 



There are local and global objects in the BiiN system. Local objects are local to a particular 
job. That means that the active version of a local object is removed when the controlling job 
finishes. 

A local object can however be passivated, and the passive version will survive when the con- 
trolling job finishes. When the passive version is again activated, its active version will again 
be a local object and will automatically disappear, once the job that activated the object 
finishes. A local object that has never been passivated will disappear completely once its 
controlling job finishes. Global objects exist outside any particular jobs. There are two types 
of global objects, unbounded global objects and countable global objects. 

An unbounded global object's active version can exist indefinitely, or more precisely, until it is 
explicitly removed by global garbage collection. Global objects can also be passivated and 
thus survive system crashes and explicit garbage collection. 
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Countable global objects behave very much like unbounded global objects. However, un- 
bounded global objects have one distinct disadvantage that countable global objects avoid: 
Unbounded global objects can only be removed by global garbage collection. Global garbage 
collection is a very expensive process because it may involve extensive disk traffic. It is 
desirable that it not be used too often. Countable global objects can be deallocated without 
global garbage collection. This is done with the following technique. 

For countable global objects, there is a mechanism that keeps track of all references to a 
particular object. Whenever an AD is given out to a job for the first time, the reference count is 
incremented by one. Also, whenever a job terminates that held an AD to the countable global 
object, the reference count is decremented by one. If the reference count equals zero, object 
management is notified and then removes the object. Note that the reference count keeps track 
of how many jobs hold references to the object, not how many ADs have been given out A 
job can also logically delete its AD to an object The job then continues to run but forfeits its 
access to the particular object. This causes the count of logically deleted references to be 
incremented. When the count of logically deleted references is equal to the reference count, 
deletion of the object also results. The BiiN™ Operating System and the hardware work 
together to prevent lifetime violations. 

ADs can also be local and global. On the simplest level, this means, ADs to a local object will 
always be local ADs. If this were not so, global ADs to a local object could outlive the object. 
For mat same reason local ADs are confined to one job. Global objects can have local and 
global ADs. Countable global objects, however, have only local ADs. This ensures that all 
ADs that belong to one job will disappear once the job terminates. 



VII-2.5 Object Deallocation Strategies 



There are various ways of removing, or deallocating, objects that are no longer needed. This is 
an important task. Without it memory would be exhausted in a very short time period. The 
way objects are deallocated depends on the object and on the needs of the job that uses them. 
In particular, there are these methods for deallocating objects: 



• Explicit Deallocation 

• Local Garbage Collection 

• Global Garbage Collection 

• Reference Counting 

• Deallocating Passive Versions. 



• Job Termination 

Explicit deallocation (using Ob ject_Mgt . Deallocate) is the simplest, most direct 
method to remove an object. It is used whenever a job "knows" that an object that it has 
created is no longer needed. Note, however, that such deallocation removes only the object's 
active representation. The object descriptor will still be there. If an AD is used to access an 
object whose representation has been deallocated and which has no passive version, the excep- 
tion System_Exceptions . ob ject_has__no__representation is raised. If there ex- 
ists a passive version of the object, it is transparently activated. Note, however, that when you 
deallocate an object's representation, the object's passive version is not updated automatically. 
If you want to save any changes on the object, you have to specifically update the passive 
version. ( 
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There is an operation available to trusted routines called 

Unsaf e_Ob ject_Mgt . Unsaf e_deallocate. This operation removes not only the 

object's representation but the object descriptor as well. This operation is unsafe because if 

there are any ADs to the object after the object has been completely removed from the system, 

a use of this AD will result in a dangling reference. A routine that uses 

Unsaf e_deallocate has to ensure that there are no ADs left to the object outside the 

routine itself. Failure to do so can cause fatal system behavior. 

Local objects for which there are no more ADs can be reclaimed by local garbage collection. 
The purpose of local garbage collection is to enable long-running jobs to periodically clean up 
their address spaces. Garbage collection can be started and then runs as a daemon. When run as 
a daemon it will wake up periodically whenever the storage claim of the job falls below a 
certain adjustable percentage. A minimum delay between runs of the garbage collector 
(GCOL) can also be specified. This is to prevent GCOL from running permanently when a 
job's storage claim becomes low. 



GCOL Daemon 




Unreferenced Object 
Figure VII-2-8. Garbage Collector 



GCOL finds each object with no reference and labels it as garbage. It then starts to remove 
these objects. Differently from an explicit Deallocate, GCOL also removes an object's 
object descriptor. It can do so because it has previously made sure that no ADs to the object 
exist. 

When a job finishes all objects local to the job are removed completely, representation, local 
ADs, and object descriptors. 

Besides the local garbage collection, there is also a global garbage collection mechanism. 
Global garbage collection works for global objects the same way local garbage collection 
works for local objects. Global garbage collection is invoked periodically by the system and 
removes all unreferenced objects. Global garbage collection is an expensive process: It may 
involve a lot of disk traffic. Therefore, global garbage collection should run as infrequently as 
possible. 

As mentioned previously, countable global objects can be removed without the overhead of 
garbage collection. 



Understanding Memory Management 



vn-2-n 



PRELIMINARY 

VII-2.6 Controlling and Accounting for Memory Resources 

Jobs are dispatched to the processor by a scheduler. The scheduler recognizes four different 
classes of jobs: batch, interactive, time-critical and real-time. What class a particular job 
belongs to, depends on what SRO the user specifies when the job is started. (A user has to have 
the necessary rights to an SRO in order to run a job from it.) Depending on the type of the job, 
a storage claim of a certain size is defined in the job's SRO by the scheduler. 

When an object is allocated from an SRO, the job's storage claim is charged. Accounting is 
done for the number of object descriptors allocated from the SRO and for the size of the 
representation of the object. If a local SRO gets to the bottom of its claim, local garbage 
collection is automatically invoked. In most cases this will result in enough memory space 
being reclaimed to be able to satisfy the job's allocation request. However, if the garbage 
collection cannot reclaim enough space to handle the job's allocation request, the job is ter- 
minated with a message that states that resources have been exhausted. Accounting is done on 
a per job and per node basis. 

In addition, the class of a job has a more subtle influence on memory allocation than just 
setting upper limits on the allowed space. In particular, it specifies whether a job is subject to 
virtual memory paging or not. In the extreme case, a job can run in frozen memory. That 
means, all of its virtual memory is primary memory. Thus all the job's objects are im- 
mediately accessible without swapping pages. This increases performance considerably. 

VII-2.7 User-Transparent Memory Management Functions 

Most of the functions of memory management are executed transparently to the user. In par- 
ticular this includes the following: 

• Object Activation 

• Virtual Memory Paging 

• Global Garbage Collection 

• Compaction 

• Optimized Handling of Instruction Objects. 

VII-2.7.1 Object Activation 

This section describes the mechanism behind transparent object activation. Typically, an 
object's representation is deallocated and a process holds an AD to the object. When the 
process touches the object, the BiiN™ Operating System finds that the object has no represen- 
tation. At that point it attempts to find the object in passive store. If it succeeds, the passive 
version is copied into active memory and becomes directly available to the requesting process. 
Otherwise, activation fails. 

VII-2.7.2 Virtual Memory Paging 

The virtual memory concept solves the problem that primary memory is scarce. A large part of 
virtual memory is secondary memory; that is disk. When a process touches a page that is 
presentiy held in secondary memory it will be swapped into primary memory. Secondary 
memory that is part of virtual memory is called swapping memory. Swapping memory is 
devided into volume sets, just as passive store. Swapping pages between swapping volume sets 
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and primary memory is invisible to the requesting processes. Extensive page swapping, 
however, slows down program execution. For that reason real-time jobs have all their memory 
requirements satisfied in primary memory. (In this case the programmer has to make sure that 
there is enough primary memory available to satisfy the job's demands.) 

VII-2.7.3 Global Garbage Collection 

The system periodically invokes a global garbage collector daemon. The daemon is responsible 
for cleaning up a node's global memory. It removes all global objects for which no AD exists 
on that node. Garbage collection runs in the background and is invisible to the user. Global 
garbage collection involves a great amount of overhead. This is because the objects that gar- 
bage collection is looking for are unreferenced objects. Objects that have not been referenced 
in a while tend to move to secondary memory. Finding all those objects and removing them 
involves a lot of disk traffic. Remember also that garbage collection has to search all objects on 
a node for references. 

VII-2.7.4 Compaction 

The representation of a simple object usually takes up less than one page of of memory (4K 
bytes). When pages are swapped out, compaction is transparently invoked. Compaction takes 
simple objects and optimizes memory use by placing multiple simple objects on one memory 
page. Swapping always happens page by page. When a user requests a simple object that is 
presently on a swapping volume set and shares a page with other simple objects, the entire 
page that holds the object is swapped in. 

VII-2.7.5 Optimized Handling of Instruction Objects 

As their name indicates instruction objects hold processor instructions and constants necessary 
for program execution. Program execution is optimized in three ways: 

• Pages of instruction objects are directly paged in from the file. You do not need to ex- 
plicitly activate (or load) the instruction object 

• The representation of a (local multiple activation) instruction object is physically shared by 
all jobs using it whenever possible. This avoids having multiple identical copies in active 
memory. 

• When a job terminates, pages of the instruction object may remain reclaimable for some 
time. That means, another job that runs later and uses the same instructions can reclaim 
those pages without having to copy them from disk. 



VII-2.8 Summary 



After having read this chapter you should now have a basic understanding of how active 
memory is managed in a BiiN™ node. In particular, you should have grasped the following 
concepts: 

• Physical memory organization 

• Virtual memory 

• The object table 

• Storage resource object 
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Objects representation 
Granularity of object sizes 
Memory types 
Object allocation 
Object lifetimes 
Object deallocation 
Control of memory resources 
Transparent memory functions 
Addressing 
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A type manager is a program module that defines a particular object type and all calls for 
objects of that type. This chapter shows you how to build a type manager. 

Packages Used: 

Ac ce s s_Mgt Interface for checking or changing rights. 
Ob j e c t_Mgt Provides basic calls for objects. 



The example for this chapter, Account_Mgt_Ex, is a simple, general-purpose type manager 
written as a Ada package. The complete listing of this example can be found in Appendix X-A. 



V1I-3.1 Concepts 



A type manager provides both data abstraction and protection for the objects of its type. It does 
so by defining all calls for its objects. No operations but the ones defined by the type manager 
are possible on the objects protected by it. It is therefore important that you provide all neces- 
sary calls when building your type manager. 

The type manager holds a key that allows it to create objects of its type and to add represen- 
tation rights to ADs that are handed to it by calling programs. The key is an AD to the TDO 
with amplify and create rights. It is given out when the TDO is first created. 

VII-3.1 .1 The Type Manager Defines All Calls for a Type of Object 

A type manager defines all basic calls for an object type. For example, the 
Account_Mgt_Ex type manager defines calls for account objects: 

I s_a c c ou nt Checks whether an AD references an account 

Create_account 

Creates an account with an initial balance. 

Cr eat e_stored_ac count 

Creates and stores an account. 

Get_balance Returns an account's balance. 

Change_balance 

Changes an account's balance. 

Transfer Moves an amount between accounts. 

Destroy_account 

Destroys an account 

Callers must use the type manager Account_Mgt_Ex to do any of the above calls on an 
account More complex calls must be composed from the type manager's basic calls. Again, it 
is important that the list of basic operations be complete, or else there is no way to do the 
operation on an account. For example, if you forgot the Destroy_account call, there 
would be no way to eliminate unneeded accounts. 
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VII-3.1 .2 Type Managers Hide Data Representation 

Type managers provide data abstraction, concealing the representation of data from callers. 
For example, Account_Mgt_Ex provides the calls Create_account and 
Change_balance that affect the data in an account. To other services, an account is an 
abstract data type; the caller doesn't need to know or care how data in the account is 
represented. 

Data abstraction makes software more: 

reliable Only the type manager accesses the representation of a particular type of 

data. If the type manager is correct, then no outside program error can 
corrupt data of the type. 

maintainable Data representation can be changed as long as the correctness of the basic 

calls is preserved. 

extensible Changes in functionality can easily be implemented as long as they are 

compatible with the existing interface. In our example, operations on ac- 
counts could be realized using transactions without any other program but 
the type manager having to be changed. 

VII-3.1 .3 Only the Type Manager Has the Key to Access the Type's Objects 

The type of an object is uniquely defined by the object's TDO. A TDO for a new type of 
object can be created with Ob ject_Mgt . Create_TDO. Ob ject_Mgt . Create_TDO 
returns an AD to the new TDO. This AD has create and amplify rights. Those are necessary to 
create new instances of the managed object, and to add access rights to ADs of managed 
objects. Any module that has a TDO with create rights and amplify rights is by definition a 
type manager for that type. 

In order to protect a newly created type, the AD to the TDO that has create and amplify rights 
should be confined to your type manager. 

VII-3.1 .4 One Module Can Manage Multiple Types 

The type manager model provides a flexible way of protecting objects. In particular, one 
module can manage as many types as you choose. However, it is obvious that the number of 
types that a type manager manages should be strongly limited. Otherwise the concept defeats 
itself. For example, it is common that one type manager manages closely related objects such 
as files and opened files. 



VII-3.2 Techniques 



This section shows you each step in building a type manager. After reading this section, you 
will be able to: 

• Define the Public Type 

• Define Type Rights 

• Define Exceptions 

• Define the Type's Calls 

• Define the Private Types 
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Define Needed Type Overlays 

Create the TDO 

Bind to a Stored TDO 

Implement the Is Call 

Implement the Create Call 

Implement Calls that Require Type Rights 

Implement Calls that Don't Require Type Rights 

Implement the Destroy Call 

Make Operations Atomic 

Initialize the Type Manager 

Protect the Type Manager from Other Services. 

The first four techniques describe the type manager's package specification, the public inter- 
face used by outside callers. 

The next eleven techniques describe the type manager's package body, the package implemen- 
tation, which is hidden from outside callers. 

The last technique describes how to use BiiN™ Ada pragmas and the BiiN™ Systems Linker to 
completely protect your type manager from other services. 

The Account_Mgt_Ex example is a type manager for accounts, each containing a long 
integer balance. It is a general-purpose type manager and could be used for inventory ac- 
counts, bank accounts, or other accounting applications. Appendix X-A contains complete 
listings for the Account_Mgt_Ex package. Various implementations of this type manager 
are described in this chapter and in Chapters VII-6 and VIII-2. The implementation described 
in this chapter is the simplest and supports active-only accounts. 

VII-3.2.1 Defining the Public Type 

The type manager's package specification defines the public type, the type used by outside 
callers to reference an account The account _AD access type is the public type for accounts. 
It references a private type account_ob ject that is defined as a null record. 

The package specification for Account_Mgt_Ex defines the public type: 

114 type account_ob ject is limited private; 
115 

116 type account_AD is access account_object; 

117 pragma access_kind(account_AD, AD); 

118 — User view of an account. 

The null record is defined in the private part of the specification: 
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295 


private 


296 




297 


type account_object is 


298 


— Empty dummy record. The real object 


299 


— format is defined in the package body 


300 


record 


301 


null; 


302 


end record; 


303 




304 


end Account Mot Ex; 



T TM 



A dummy record format is defined because the BiiN Ada compiler requires a record layout in 
the package specification, but it is still desirable to conceal the actual object representation in 
the package body. The account_ob ject type is never actually used, because account ADs 
lack rep rights and cannot be used to read or write account objects. Actual reading and writing 
is done within the package body with types defined there. 

VII-3.2.2 Defining Type Rights 

Type rights allow a type manager to differentiate between users. The implementer of the type 
manager can require certain type rights for certain calls. It may also permit certain calls with- 
out any type rights. In the example presented here, the Is_account call is an example of a 
call that requires no type rights. (For more details, see Section VII-3.2.9.) 

Declarations Used: 

Ob j e ct_Mgt . r ight s_ma sk 

Access rights type. 

Ob ject_Mgt .modif y_rights 
Modify type right. 

Ob ject_Mgt . control_rights 
Control type right. 



The type manager's package specification typically gives type-specific names to the type rights 
that it uses. The type manager's calls can check for needed rights before performing the call. 
A type manager does not always have to define all three rights. By convention, unused type 
rights should always be left turned on; otherwise a higher level routine will not be able to use 
them. 

Account_Mgt_Ex defines two type rights: 

121 change_rights : constant 

122 Object_Mgt.rights_mask := 

123 Object_Mgt .modi fy_r ight s; 

124 — Required to change an account's balance. 
125 

126 destroy_rights: constant 

127 Object_Mgt.rights_mask := 

128 Object_Mgt.control_rights; 

129 — Required to destroy an account. 

If an account call is made without needed rights, then 

System_Exceptions . insuf f icient_type_rights is raised. 
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VII-3.2.3 Defining Exceptions 

The type manager's package specification defines any type-specific exceptions raised by its 
calls. Account_Mgt_Ex defines these exceptions: 

94 insuf ficient_balance: exception; 

95 pragma except ion_value (insuf ficient_balance, 

96 insufficient_balance_code ' address ) ; 

97 — An operation failed because it would 

98 — cause a negative account balance. 
99 

100 balance_not_zero: exception; 

101 pragma exception_value(balance_not_zero, 

102 balance_not_zero_code' address) ; 

103 — "Destroy_account" was called on an account 

104 — with a nonzero balance. 

Text messages to be displayed by CLEX when an exception occurs can be bound to these 
exceptions at compile-time. These messages can be displayed on a terminal, for example. 

71 insuf ficient_balance_code: 

72 constant Incident_Defs. incident_code := 

73 (0, 1, Incident_Defs. error, System. null_word) ; 
74 

75 — *D* manage. messages 

76 — *D* store :module=0 :number=l \ 

77 — *D* :msg_name=insufficient_balance_code \ 

78 -- *D* :short= \ 

79 — *D* "An account operation failed because it\ 

80 — *D* would create a negative balance." 
81 

82 balance_not_zero_code : 

83 constant Incident_Defs.incident_code := 

84 (0, 2, Incident_Defs. error, System. null_word) ; 
85 

86 — *D* store :module=0 :number=2 \ 

87 __* D * ;short= \ 

88 — *D* "An account cannot be destroyed because\ 

89 — *D* it has a non-zero balance." 

90 — *D* exit 

VII-3.2.4 Defining the Type's Calls 

The type manager's package specification defines all calls available to outside callers of the 
type. 

Calls typically provided for a type T are: 

I s_T Checks whether an object is of type T. Only the type manager can refer- 

ence 7"s TDO and make this check. 

Cr eate_T Creates a T object Only the type manager can create and initialize T 

objects. 

xxx_T Any calls that need to read or write T objects. Only the type manager can 

read from or write to the object's representation. 

De st roy_T Destroys a T object. Only the type manager can explicitly deallocate T 

objects. 

Account_Mgt_Ex defines all the typical calls: 
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Is_account 

Create_ac count 

Create_stored_account 

Get_balance 

Change_balance 

Transfer 

Destroy_account 

It might appear at first glance that the Transfer call is not necessary since it can be com- 
posed of two calls to Change_balance. The problem with this solution is that it could 
happen that the calling program fails before it completes the transfer. Thus an amount may be 
deducted from the source account and not be deposited in the target account The Transfer 
call is set up to be an atomic operation. It can only succeed as a unit and not partially. This 
concludes the type manager's package specification. The following techniques are done in the 
first body of Account_Mgt_Ex. 

VII-3.2.5 Defining the Private Types 

The type manager's package body defines the private types used inside the type manager to 
reference the accounts. The account_rep_ob ject type defines the object's represen- 
tation. The account_rep_AD type is used for ADs with rep rights, allowing the type 
manager to read and write the representation: 

38 type account_rep_ob ject is 

39 record 

40 balance: Long_Integer_Defs.long_integer; 

41 — Current balance. 

42 end record; 
43 

44 type account_rep_AD is access account_rep_object; 

45 pragma access_kind{account_rep_AD, AD); 
4 6 — Private view of an account. 

VH-3.2.6 Defining Needed BiiN™ Ada Type Overlays 

The Account_Mgt_Ex package body requires three different BiiN™ Ada types to represent 
the AD to one of its objects: 

ac count_AD Public AD without rep rights. 

System . untyped_word 

Type required for Access_Mgt and Ob ject_Mgt calls. 

account_rep_AD 

Private AD with rep rights. 

Instead of instantiating unchecked_conversions type overlays are used here to the same 
goal. This is done using a BiiN™ Ada address clause. (Refer to the BiiN" 1 Ada Language 
Reference Manual for more details.) 
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180 account_rep : account_rep_AD; 

181 FOR account_rep USE AT account' address; 

182 account__untyped : System. untyped_word; 

183 FOR account_untyped USE AT account' address; 



Note that this technique has no runtime cost. 



VII-3.2.7 Creating the TDO 

The package body described in this chapter is an active-objects-only package body, so every 
time the package initializes it creates a TDO. This poses no problems as long as objects of the 
type are not passivated or do not outlive their TDO or type manager. (This is explicitly 
enforced - refer to Section VII-3.2.16 in this chapter for more details.) 

48 account_TDO: constant Object_Mgt .TDO_AD := 
4 9 Object_Mgt.Create_TDO; 

A stored object should use a stored TDO as its type, as described in the next section. 

VH-3.2.8 Binding to a Stored TDO 

If objects of the type can outlive a particular job, then the TDO should be a stored object, 
created once by the system administrator. 

The type manager's package body then uses the BiiN™ Ada bind pragma to obtain the needed 
TDO AD with all type rights. The following example is excerpted from the second body of 
Account_Mgt_Ex package body in Appendix X-A. In this example, the account_TDO is 
first assigned a null value, then used in the pragma bind: 

52 accountJTDO: constant Object_Mgt .TDO_AD := null; 

53 — This is a constant AD but not really null; its 

54 — filled in with an AD retrieved by the linker. 

55 pragma bind (account_TDO, 

56 "account"); 

57 — Bind to TDO for accounts. 

This technique declares a BiiN Ada access type variable which is initialized with null at 

TM TM 

compile-time. The BiiN Ada pragma bind is an instruction to the BiiN Systems Linker 
to retrieve an AD from the directory entry that is named by the second argument of pragma 
bind. (For more details on BiiN™ Ada pragmas refer to the BUN"* Ada Language Reference 
Manual.) The linker reinitializes the variable with the activated AD. 

Vll-3.2.9 Implementing the is_account Call 

The Is call checks whether an object has the type managed by the type manager. 

Calls Used: 

Ob ject_Mgt . Retrieve_TDO 

Retrieves object's TDO. 



Is_account returns true if obj 's type equals account_TDO, false if ob j is null or has 
another type: 

70 begin 

71 return obj /= System. null_word and then 

72 Object_Mgt .Retrieve_TDO (ob j) = accountJTDO; 

73 end Is account; 
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VII-3.2.10 Implementing the Create_account Call 

The Create call allocates an object of the right size and type, initializes the representation, 
and returns an AD with no rep rights. 

Calls Used: 

Ob ject_Mgt .Allocate 

Allocates an object with specified size and type. 

Access_Mgt .Remove 

Removes rights. 



The Create_account call creates an account with a specified starting_balance: 

94 begin 

95 if startingjbalance < Long_Integer_Defs.zero then 

96 RAISE insuf ficient_balance; 
97 

98 else 

99 account_untyped := Ob ject_Mgt .Allocate ( 

100 size => Object_Mgt ,object_size ( 

101 (account_rep_object'size + 31) /32), 

102 — Expression computes number of words 

103 — required to hold the number of bits 

104 — in an account. 

105 tdo => account_TDO) ; 
106 

107 account_rep.all := account_rep_object' { 

108 balance => starting_balance) ; 
109 

110 account_untyped := Access_Ngt .Remove ( 

111 AD => account_untyped, 

112 rights => Object_Mgt .read_write_rights) ; 

113 RETURN account; 
114 

115 end if; 

116 end Create_account; 

The BiiN™ Ada new operator cannot be used here to allocate the object, because new by 
default allocates a generic object instead of an object with the desired type account. 
However, if we had made use of the Ada pragma allocate_with we could have specified 
a TDO to be used with the new operator. Thus we would obtain objects of the proper type 
when using new. 

The size specified to Allocate is the number of 32-bit words. The BiiN™ Ada attribute 
size yields the number of bits required for the object's representation. The expression 
(account_rep_object' size + 31) /32 yields the smallest number of 32-bit words 
with at least the required number of bits. 

VII-3.2.11 Implementing the Create_stored_account Call 

Our particular example provides two Create calls, one that simply creates an object and 
returns an AD, and another that also stores the object with a pathname. The implementation 
discussed in this chapter does not support stored objects, however. For this reason the the 
Create_stored_account function simply raises the 

System_exception . operation_not_supported exception as shown in the follow- 
ing excerpt from this implementation: 
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119 function Create_stored_account ( 

120 start ing_balance: 

121 Long_Integer_Def s . long_integer := 

122 Long_Integer_Defs . zero; 

123 master: System_Def s. text; 

124 authority: 

125 Authority_List_Mgt. author ity_list_AD := null) 

126 return account_AD 
127 

128 — Logic: 

129 — This call is not supported by this implementation. 
130 

131 is 

132 begin 

133 RAISE System_Exceptions.operation_not_supported; 

134 RETURN null; 
135 

136 end Create_stored_account; 

VII-3.2.12 Implementing Calls that Require Type Rights 

For calls that require type rights, the type manager checks the rights on the caller's AD before 
performing the requested operation. The usual way to do this is with 
Access_Mgt . Import, which checks type rights before adding rep rights. Import raises 
System_Exceptions . insuf f icient_type_rights if needed rights are not present. 

Calls Used: 

Access_Mgt . Import 

Checks for rights and adds rep rights. 



Declarations Used: 

System_Exceptions . insuf ficient_type_rights 

Raised when the AD does not have the type rights needed for the call. 



In Account_Mgt_Ex, the call Change_balance requires that the caller have change 
rights on the passed AD: 



VII-3- 10 Building a Type Manager 



PRELIMINARY 



190 begin 

191 account_untyped := Access_Mgt . Import ( 

192 AD => account_untyped, 

193 rights => change_rights, 

194 tdo => account_TDO) ; 
195 

196 new_balance := account_rep. balance + amount; 
197 

198 if new_balance < Long_Integer_Def s. zero then 

199 RAISE insufficient_balance; 
200 

201 else 

202 begin 

203 old_balance := account_rep. balance; 

204 account_rep. balance := new_balance; 

205 RETURN new_balance; 

206 exception 

207 — An exception in this inner block means 

208 — that something has gone wrong with the 

209 — update. The old balance is restored. 

210 when others => 

211 account_rep. balance := old_balance; 

212 RAISE; 

213 end; 
214 

215 end if; 

216 end Change_balance; 

The call Access_Mgt . Import checks the AD for change rights before adding rep rights. 

VII-3.2.13 Implementing Calls that Do not Require Type Rights 

Calls that don't require type rights don't need to check the type rights before performing the 
call. As a result, the type manager can use Acces s_Mgt . Amplify, which adds rights 
without doing a check for type rights. 

Calls Used: 



Access_Mgt .Amplify 

Adds rights without checking type rights. 



An example of a call that doesn't require type rights is Account_Mgt . Get_balance. In 
this case, read rep rights are amplified: 

151 begin 

152 account_untyped := Access_Mgt .Amplify ( 

153 AD => account_untyped, 

154 rights => Object_Mgt .read_rights, 

155 tdo => account_TDO) ; 

156 return account_rep. balance; 

157 end Getjbalance; 

VII-3.2.14 Implementing the Destroy Call 

A type manager's Destroy call usually checks type rights for this destructive act, then deal- 
locates the object's representation. 
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Calls Used: 

Access_Mgt . Import 

Checks for rights and adds rep rights. 

Ob ject_Mgt .Deallocate 

Deallocates the object's representation. 



In the following example from Account_Mgt_Ex s the call Ob ject_Mgt . Import checks 
for the appropriate type rights, then adds rep rights to the AD in order to be able to check the 
balance. If the balance in the account is zero, the account will be deallocated using 

Ob ject_Mgt .Deallocate: 

326 begin 

327 account_untyped := Access_Mgt. Import ( 

328 AD => account_untyped, 

329 rights => destroy_rights, 

330 tdo => account_TDO) ; 
331 

332 if account_rep. balance /= Long_Integer_Defs . zero then 

333 RAISE balance_not_zero; 
334 

335 else 

336 Ob ject_Mgt .Deallocate (account_untyped) ; 
337 

338 end if; 

339 end Destroy_account; 

VII-3.2.15 Making Operations Atomic 

Although the transfer call can in principle be composed of two successive calls to 
Change_balance there is a considerable disadvantage to this method; the process that per- 
forms the two calls could encounter an exception after performing the first call and before the 
second. If that happened, one account would be charged (or credited) but not the other one. 

Calls Used: 

Access_Mgt . Import 

Checks for rights and adds rep rights. 
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265 begin 

266 source_untyped := Access_Mgt. Import ( 

267 AD => source_untyped, 

268 rights => change_rights, 

269 tdo => account_TDO); 

270 dest_untyped := Access_Mgt. Import < 

271 AD => dest_untyped, 

272 rights => change_rights, 

273 tdo => accountJTDO) ; 
274 

275 new_source_bal := source_rep. balance - amount; 

276 new_dest_bal := dest_rep. balance + amount; 
277 

278 if new_source_bal < Long_Integer_Defs . zero 

279 or else 

280 new_dest_bal < Long_Integer_Defs.zero then 

281 RAISE insufficientjbalance; 
282 

283 else 

284 old_source_bal := source_rep. balance; 

285 old_dest_bal := dest_rep. balance; 

286 — Old balances are recorded here 

287 — in case the update will have to be 

288 — rolled back. 

289 begin 

290 source_rep. balance := new_source_bal; 

291 dest_rep. balance := new_dest_bal; 

292 exception 

293 — An exception in this inner block means 

294 — that something has gone wrong with 

295 — the update. Restore the old balances to make 

296 — this operation atomic, then 

297 — reraise the exception. 

298 when others => 

299 source_rep. balance := old_source_bal; 

300 dest_rep. balance := old_dest_bal; 

301 RAISE; 
302 

303 end; 

304 RETURN; 
305 

306 end if; 

307 end Transfer; 

The new balances of both the source and the destination account are computed. If either one is 
less than zero, the insuf f icient_balance exception is raised. Before the balances in the 
accounts are physically changed, they are stored. Any exception that is raised while the new 
balances are assigned causes the update to be rolled back and the original balances to be 
restored. 

Vil-3.2.16 initializing the Type Manager 

The example that we discuss in this chapter manages accounts that cannot be passivated. In 
order to make sure that accounts cannot be passivated, the account TDO must contain the 
passive store attribute, bound to an instance that refuses requests for passive store operations. 

Calls Used: 

Passive_Store_Mgt . Set_ref use_f ilters 

Sets a type manager's passive store attributes object to refuse all outside 
requests for passive store operations. 

Attribute_Mgt . Store_attribute_f or__type 
Stores an attribute entry in a TDO. 
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350 begin 

351 Passive_Store_Mgt .Set_refuse_filters ( 

352 passive_store_impl) ; 

353 Attribute_Mgt . Store_attribute_f or_type ( 

354 tdo => account_TDO, 

355 attr_ID => Passive_Store_Mgt.PSM_attributes_ID, 

356 attr_impl => passive_store_impl_untyped) ; 

357 end; 

Note that this piece of code is executed every time this package is initialized. Also, a new TDO 
is created at that time. The TDO and all the objects of the type manager are deallocated when 
the job that uses this package finishes. 

A more general package body would be able to handle objects that can be passivated. In this 
case the TDO should only be created once and stored. This can be done by the system ad- 
ministrator using the create . TDO command in the configure utility. (For more details 
see the BiiN™ Systems Administrator's Guide.) You could also write a program that will ex- 
ecute only once, create a TDO and store it. The Stored_Account_TDO_Init_Ex proce- 
dure in Appendix X-A is an example of such a program. 

VII-3.2.17 Protecting the Type Manager from Other Services 

Finally, a type manager may want to protect its address space from other services so that it and 
its objects are safe from accidental destruction or modification. Protecting the type manager's 
address space involves: 

TM 

1. Creating a distinct address space with the BiiN Systems Linker. 

2. Protecting the type managers address space from calling services via pragma 

protect ed_return. 

The idea is to link the type manager into its own separate domain. In addition it might be 
desirable to put the type manager into its own subsystem. That means that the type manager 
will not share stacks with other services. 

Refer to the BiiN™ Systems Linker Guide for information on how to create the type manager's 
own address space at link time. You will need to create a distinct domain and a distinct 
subsystem ID. 

The BiiN™ Ada pragma protected_return ensures that all global registers will be cleared 
before control is returned to the calling process. This is to protect ADs that may have been left 
in the global registers by the call. Refer to the BiiN™ Systems Linker Guide for more infor- 
mation on these topics. (Pragma protected_call is similar to protected_return; 
however it protects the calling routine from the routines it calls. Account_Mgt_Ex only 
calls OS routines. Therefore protected_call could be used here but is not really 
necessary.) 

There is a performance penalty involved when you create a protected address space for a type 
manager. You will use extra memory for the type manager's distinct stack. There is also a 
time penalty when performing calls to a distinct domain. 
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VII-3.3 Summary 

• A type manager defines an object type and all basic calls for the type. 

• Only the type manager can read from or write to the type's objects. 

• A type is represented by a TDO. 

• Type managers provide data abstraction, enhancing software reliability and main- 
tainability. 
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An attribute is a package or data structure that can be defined for multiple objects or object 
types. Such packages or structures can be used independent of an object's type and without 
calling its type manager. 

An attribute usually defines a set of operations that is supported by multiple objects, or object 
types, such as an I/O access method. 

Packages Used: 

Attribute_Mgt Manages attribute IDs and provides calls to store and retrieve attribute 
instances. 

Ob j e ct_Mgt Provides basic calls on objects. 



An attribute can be defined either for an object or for an object type. In case of type attributes, 
an attribute list is contained in the Type Definition Object (TDO). In the case of object at- 
tributes, an attribute list is attached to the object proper. Whether in the TDO or attached to an 
individual object, an attribute list contains one or more <attribute ID, attribute instance> pairs. 
The attribute ID in the pair identifies the attribute (for example, the Byte Stream Access 
Method). The attribute instance in the pair references the object- or type-specific attribute 
value (for example, the type-specific implementation of the access method for the particular 
device type). An example of an object-specific attribute is execute. An executable object 
can be a CLEX script, a BiiN™ /UX script, or an executable program. The attribute instances in 
this case specify how the object is to be executed. 

Figure VII-4-1 shows the attribute data structure for a type-specific attribute. 



TDO 




Figure VII-4-1. Attribute Structure 



In this chapter you will find an example of how to use type-specific attributes. Using object- 
specific attributes is very similar to what is shown in the example. In addition, in each section 
you will find information on how to achieve the particular step for an object-specific attribute. 

In a later release we may have an example of an object-specific attribute. 
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VII-4.1 Concepts 



_TM 



The attributes described in this chapter should not be confused with BiiN Ada attributes, used 
to indicate properties of declared entities in that language. 

Even though using an attribute is independent of the object or its type, defining the attribute 
instances supported by an object or a type is specific to an object or a type. In the case of a 
type attribute, only the type manager can store attributes in the TOO, normally at system or 
program initialization when the TDO is created. In the case of an object attribute, anyone with 
control rights can store an attribute. But type-specific attributes cannot be overridden by 
object-specific attributes. 

Though in most cases an attribute value is an AD to a package, an attribute value can be any 
System . untyped_word, either an AD to an object or a 32-bit data value. The attribute 
value can reference any object, not just a package. An example of an attribute value that does 
not reference a package is Passive_Store_Mgt . PSM_attributes_ob ject where 
the attribute value is an AD to a record. 

If an attribute is a package, invoking the attribute package's calls uses a fast attribute call 
mechanism supported by the OS and BiiN™ Ada. This mechanism uses the object type of the 
first parameter to a call to choose the appropriate type-specific instance of the package. This 
mechanism is used by many OS attributes, including all I/O access methods. If an attribute 
call is made on an object that does not support the attribute, then the 

Standard . constraint_error exception is raised. The opinions vary on what excep- 
tion will actually be raised. Also in the running are 
SystemJExceptions .bad_parameter and 
System_Exceptions . operation_not_supported. 

Figure VII-4-2 shows an OS attribute, the Byte Stream Access Method, defined by the 
Byte_Stream_AM package, that is supported by different object types, such as opened files 
and opened pipes. Each object type has a type-specific implementation of the access method 
but applications need only call Byte_Stream_AM and their call is efficiently switched to the 
right implementation by the attribute call mechanism. 
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Byte_Strean_AM,Dps.Wr i te <opened_olev, louffer_VA, , . .)j 




Figure VII-4-2. An OS Attribute 



The OS defines many attributes used by type managers to customize System Services for their 
particular types. Every OS attribute appears to an application as another System Service. At 
the same time, implementers of new services can define type-specific instances of these OS 
attributes, without modifying, recompiling, or relinking the OS. You can use attributes to 
extend and customize the OS ~ without accessing its internals in any way. 

The "OS Attributes" appendix in the BiiN^/OS Reference Manual summarizes all OS at- 
tributes. Some commonly used OS attributes are: 

• Byte stream I/O, specified by the Byte_Stream_AM . Ops package. 

• Record I/O and record keyed I/O, specified by the Record_AM . Ops and 
Record_AM.Keyed._Ops packages. 

• Character display I/O, specified by the Charact er_Display_AM . Ops package. 
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• Passive store, specified by the Passive_Store_Mgt . PSM_attributes_ob ject 
record type. 

• The execute attribute, specified by Execut ion_Support . Ops, an example of an at- 
tribute that can be object-specific. 

VII-4.2 Techniques 

There are three techniques in using attributes: 

• Defining a new attribute 

• Defining a type-specific attribute instance for a type 

• Initializing the type's TDO to refer to the attribute and instance. 

Because attributes are most often packages, this section uses a simple package attribute for all 
three examples. This attribute contains a single call, which returns a type-specific type name. 
For example, for account objects, the type-specific instance will return the string "account". 
This example is not as useful as many attributes, such as I/O access methods, but its simplicity 
allows you to easily understand programming with attributes. 

VII-4.2. 1 Defining a New Attribute 

You will more often define attribute instances than define new attributes. We begin with 
defining an attribute because the example attribute is used by the subsequent techniques. 

Calls Used: 

Attribute_Mgt . Create_attribute_ID 
Creates a new attribute ID. 



You create a new attribute by calling Attribute_Mgt . Create_attr ibute_ID. In this 
call you can specify whether the new attribute is type-specific or not. Type-specific attributes 
can only be stored in a TDO and not in an object's attribute list. The newly created attribute ID 
should be stored in the aid directory in the node's root directory. 

The Type_Name_Attribute_Ex example package assumes that the attribute has already 
been created and stored. It binds the previously created ID to an attribute package using the 

TM 

BiiN Ada pragma bind. 

7 type_name_attr_ID : constant 

8 Attribute_Mgt.attribute_ID_AD := null; 

9 pragma bind (type_name_attr_ID, 

10 "typnamattr") ; 

11 — Attribute ID is retrieved at link time using the 

12 — specified pathname. Should have store rights. 

The attribute package Type_Name_Attribute_Ex defines two functions: one to get the 
attribute ID and one to return a type's name. 

The Get_type_name_attr_ID function returns the new attribute's ID, required to store 
an instance of the type-name attribute: 
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14 function Get_type_name_attr_ID 

15 return Attribute_Mgt . attribute_ID_AD; 

16 — Type name attribute ID, with type rights. 
17 

18 — Function: 

19 — Returns the type name attribute's attribute ID. 

The nested Ops package contains the calls to be defined by each type-specific instance. Only 
subprograms can be declared in such a package. The package_type pragma declares the 
nested Ops package to be a package type. 

23 package Ops is 

24 pragma package_type ("typnamattr") ; 
25 

26 — Function: 

27 — Provide "Type_name" attribute call. 
28 

29 

30 function Type_name ( 

31 obj: System. untyped_word) 

32 — Any object that supports 

33 — the type name attribute. 

34 return string; — Name of the object's type. 

35 pragma interface (value, Type_name); 
36 

37 — Function: 

38 — Returns a printable name for an object's type. 
39 

40 

41 end Ops; 

Calls to any operations declared in the Ops package are switched to the proper instance, using 
the the first parameter to the call to select the instance. 

The Ops . Type__name function body is empty. An empty subroutine body is allowed here 
due to the package_type pragma: 

23 package body Ops is 
24 

25 — Logic: 

26 — Attribute packages have null bodies. 
27 

28 

29 end Ops; 

Defining the attribute is done no differently for an object-specific attribute. In fact, an attribute 
that is not labeled as type-specific can be added to the attribute list of an object 

VII-4.2.2 Defining an Attribute Instance 

An attribute instance is simply a package that matches ("conforms to") the attribute's Ops 
package template and that is bound to that template using the package_value pragma: 
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1 with System, 

2 Type_Name_Attribute_Ex; 
3 

4 package Account_Type_Name_Ex is 

5 pragma package_value (Type_Name_Attribute_Ex.Ops) ; 
6 

7 — Function: 

8 — Defines the type name attribute for accounts. 
9 

10 — A type that supports this attribute has a 

11 — printable name. For example, a directory 

12 — listing utility could use this attribute to 

13 — print the types of the objects in a 

14 — directory. 
15 

16 

17 function Type_name ( 

18 ob j : System. untyped_word) 

19 return string; 

20 — Name of the "account" object type. 
21 

22 — Function: 

23 — Returns the type name for account objects. 
24 

25 

26 pragma external; 

27 

28 end Account_Type_Name_Ex; 

Note that the instance does not contain a nested Ops package. It corresponds to the attribute's 
nested Ops package and it will be called whenever one of the general Ops routines is called 
with a first parameter that is an object to which the attribute applies. Note that pragmas 
package__value and package_type occur paired. They can be compared to a type 
definition and a variable declaration in BiiN™ Ada. 

The Account_Type_Name package body simply returns the name "account" when its 
Type_name function is called: 

1 with System; 
2 

3 package body Account_Type_Name_Ex is 
4 

5 

6 function Type_name ( 

7 obj: System. untyped_word) 

8 return string 

9 is 

10 begin 

11 return "account"; 

12 end Type_name; 
13 

14 

15 end Account Type Name Ex; 
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Calls Used: 

Attribute_Mgt . Store_attribute_f or_type 

Stores attribute ID and instance in TDO. 



The implementation of the type-name attribute for accounts must be stored in the account TDO 
to be useful. The following excerpt is from the Stored_Account_lnit_Ex example 
package body: 
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60 type_name_impl: System. untyped_word; 

61 — Implementation of type name attribute 

62 — for accounts . 

107 type_name_impl := Account_Type_Name_Ex'package_value; 
108 

109 Attribute_Mgt .Store_attribute_for_type { 

110 tdo => accountJTDO, 

111 attr_ID => Type_Name_Attribute_Ex. 

112 Get_type_name_attr_ID, 

113 attr_impl => type_name_impl ) ; 

The ' package_value BiiN™ Ada attribute (not to be confused with an OS attribute) is used 
to obtain an AD for the type-specific Account_Type_Name_Ex package, an AD which is 
then stored in the TDO. 

Handling TDOs and attributes that are stored objects is described in Chapter II-3. 

VII-4.2.4 Initializing an Objects Attribute List 

Calls Used: 

Attribute_Mgt . Retrieve_attribute_list 

Get's an object's attribute list. If none exists, creates one. 

AttributeJMgt . Store_attribute_f or_ob ject 
Stores attribute ID and instance in TDO. 



Before you can use an object-specific attribute you have to store it in the object's attribute list. 
To do so, ou have to retrieve the attribute list with 

Attribute_Mgt . Retrieve_attribute_list. This returns an AD to the object's at- 
tribute list. If none exists, a new attribute list is created. Finally, you can store the attribute 
using Attribute_Mgt . Store_attribute_f or_ob ject. 

VII-4.3 Summary 

• An attribute is a package or data structure that can be defined for multiple objects or types. 

• Explicitly type-specific attributes can only be associated with a type, not any object. 

• An attribute instance is an attribute's value for a particular object or type. 

• Attributes are identified by attribute ID objects. 

• A type manager stores type_specific attribute instances of attributes that it supports in its 
TDO. 

• Anyone with control rights to an object and store rights to an attribute can store that at- 
tribute in the object's attribute list. 
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This chapter points out how you can use certain tools to manage active memory. This chapter 



TM 



does not explain underlying concepts and models of memory management in a BiiN system. 
Refer to Chapter VII-2 for a conceptual explanation of active memory. 

For the most part, memory is managed automatically by the OS. You will want to read this 
chapter if you want to use optional calls to monitor and control your program's memory use. 

Packages Used: 

Ob j e ct_Mgt Provides basic calls on objects. Includes a call to shrink the calling 
process's stack. 

SRO__Mgt Provides calls to get memory information and control local garbage collec- 

tion. 



VII-5.1 A Brief Overview of How Memory Is Allocated 

Virtual address space in active memory is managed on a per-job and per-node basis. Each job 
has a special type of object associated with it that represents memory and objects local to the 
job and shared by all its processes. This object is known as a local storage resource object 
(SRO). 

A local SRO provides a job with its own local address space, a subset of the node's virtual 
address space. Objects in the address space can be reclaimed by starting a local garbage 
collection daemon. The daemon is basically a memory optimization technique used for long- 
running jobs. It deallocates unreferenced objects (that is, objects with no ADs). Seethe 
SRO_Mgt . Start_GCOL call. 

NOTE 

Local garbage collection should be started in long-running jobs that need to respond 
quickly to events, terminal input, or other stimuli. If local garbage collection is not 
started by the job itself, then local garbage collection is done synchronously whenever the 
job reaches one of its memory limits. Synchronous local GCOL suspends all other 
processes in a job until it completes. 

NOTE 

Memory resources can be consumed by system calls other than those that explicitly al- 
locate memory. For example, every time a transaction is started, the transaction counts 
against the job's "countable object" limit, even after the transaction is committed or 
aborted. Local GCOL will detect that the job is not using the transaction any longer and 
will decrement the job's "countable object count" accordingly. 

Some more information about the local SRO: 

• The local SRO is shared by all processes in the job, and only by the processes in the job. 



All processes in a job have implicit access to their job's local SRO. 

Most object allocation operations require an SRO as a parameter. This parameter defaults 
to the local SRO of the job to which the calling process belongs. 
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SROs have a number of properties that indicate how the objects allocated from an SRO are 
treated by various memory management functions. These properties are: 



relative lifetime 

memory type 
memory priority 



Determines when objects can be deleted (that is, deallocation of both the 
object's representation and its unique object descriptor) and constrains the 
storing of ADs in objects. 

Determines whether or not parts of an address space can be relocated. 

Determines the frequency with which unused pages are swapped out of 
active memory; also determines when small segments are compacted onto 
a single page. 

Determines the amount of virtual storage allowed for all objects allocated. 



allocation limits 

Each one of these properties is discussed in more detail in Chapter VII-2. 



VII-5.2 Collecting Garbage Objects - GCOL 



Unreferenced objects in active memory (that is, objects with no active ADs) are periodically 
collected and deleted. This garbage collection (GCOL) is generally done automatically by the 
system, although it can be configured to clean up local objects for long-running jobs. 



VII-5.2.1 Local GCOL 



Local garbage collection is executed by a special daemon process in a particular job. The 
daemon is only present if a process in the running job requests it and can be deleted at times 
when no garbage collection is needed. 

It is useful to configure local GCOL for long-running jobs. When local garbage collection is 
configured for a job, it can be triggered in one of two ways: 

• Automatically, whenever one of the remaining claim values becomes smaller than a per- 
centage of the original claim set by the programmer. 

• Manually, by calling SRO_Mgt . Start_GCOL with all parameters defaulted. 

The effect of a SRO_Mgt . St art__GCOL depends on the values of the parameters. Table 
VII-5-1 summarizes the key parameters. Selected parameter combinations are used to start the 
daemon manually and then to stop GCOL by deleting the daemon. See "Techniques" in this 
chapter. 

Table VII-5-1. Key GCOL Parameters 



Parameter 


Description 


storage_claim_percent 


Threshold value at which GCOL daemon 
wakes up. A percentage of the original 
number of words of virtual space that 
the specified SRO is allowed to allocate. 


OTP_claim_percent 


Threshold value at which GCOL daemon 
wakes up. A percentage of the original 
number of object table pages (OTP) 
assigned for the specified SRO. 


minimum_del ay 


Minimum time between runs of the GCOL 
daemon. 



This can have the effect of starting up the daemon. To prevent the daemon from running too 
often, a minimum delay can be specified as one of the trigger parameters. Garbage collection 
will not be triggered automatically if the elapsed time since it started its previous run is smaller 
than the minimum delay. Table VII-5-2 lists the special parameter values and their effect. 
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Table VII-5-2. GCOL Parameters to Start and Stop Special GCOL 



Effect 


Stop GCOL 


Start GCOL 


storage_claim_percent 





100 


OTP_claim_percent 





100 


minimum_delay 


max_int 


null_time 



The max_int and null_time constants are defined in the Long_Integer_Def s and 
System_Def s packages under "Support Services." 

The garbage collection algorithm has these properties: 

• Only objects that are garbage at the time the algorithm starts will be collected. 

• Garbage objects are deleted during the final phase of the algorithm. 

SRO_Mgt . Read_SRO_inf ormation returns garbage collection related information. 

Figure VH-5-1 shows the algorithm used by the system to determine when global garbage 
collection is performed: 



AND 



% remaining_storage_claim < storage_claim_j?ercent 
/ 
OR 
/ \\ 
/ % remaining_OTP_claim < OTP_claim_percent 



\\ 



start_time + minimum_delay < current_time 



Figure VII-5-1. Algorithm That Controls Garbage Collection 

SROJMgt . Start_GCOL parameters specify when the GCOL daemon should begin running. 
When either of the claims granted to the job's local SRO drops below the trigger values and 
the minimum delay condition is met, the daemon starts running. 



VII-5.2.2 Global GCOL 



Global garbage collection runs periodically and collects garbage objects allocated from both 
global SROs. Since global ADs may be stored in any object, all objects (local and global) on 
the node are checked. As with local garbage collection, objects and their associated space are 
only deleted during the final phase of the algorithm. Internally, the system minimizes the need 
for global garbage collection by minimizing the generation of global garbage. 
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VII-5.3 Techniques 

After reading this section, you will be able to: 

• Trim the caller's stack 

• Start local garbage collection 

• Stop local garbage collection 

• Get information about a job's local memory. 

All techniques are taken from the Memory_ex example in Appendix X-A. 

VII-5.3.1 Trimming the Caller's Stack 

A process can use an event handler to trim its stack in response to the Event_Mgt . gcol 
local event which is signalled to each process in a job whenever a local GCOL daemon is 
triggered. 

Calls Used: Ob ject_Mgt . Trim_stack 

Shrinks the calling process's stack. 



Basically, Trim_stack looks at the process's current call stack pointer and then resizes the 
stack. 

29 Object_Mgt.Trim_stack; 

Trimming the stack frees memory and reduces the number of ADs that the local GCOL 
daemon must scan, thus speeding up garbage collection. 

VH-5.3.2 Starting Local Garbage Collection 

To trigger local GCOL to start immediately in the calling job, you can use default parameters. 

Calls Used: 

SRO_Mgt . Start_GCOL 

Controls the local GCOL daemon. 



For example: 

3 5 SRO_Mgt . Start_GCOL; 

This will trigger the GCOL daemon to begin reclaiming space allocated from the job's local 
SRO. 

VII-5.3.3 Setting/Changing Local GCOL Parameters 

Local GCOL parameters can be configured to trigger the local GCOL daemoa The daemon is 
triggered only when the conditions specified in the configuration are met. 
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Calls Used: 

SRO_Mgt . Start_GCOL 

Controls the local GCOL daemon. 



For example, you might want to configure a local garbage collection daemon to run in the 
calling job when it has used 50% of its storage claim or 50% of its object table page claim, and 
at least 5 minutes has elapsed since a previous local GCOL ran in the job. 

45 SR0_Mgt . Start_GCOL ( 

4 6 storage_claim_percent => 50, 

47 OTP_claim_percent => 50, 

48 minimum_delay => 

4 9 Long_Integer_Def s . " *" ( 

50 Long_Integer_Defs.long_integer' (0, 5), 

51 System_Defs.stu_jper_min) ) ; 

VI1-5.3.4 Stopping Local Garbage Collection 

A local GCOL daemon, once started, can be stopped using a Start_GCOL call. 

Calls Used: 

SRO_Mgt . Start_GCOL 

Controls local GCOL. 



For example: 

58 SR0_Mgt.Start_GCOL(0, 0, Long_Integer_Def s.max_int) ; 

This will kill any local garbage collection daemon in the calling job. It does nothing if there is 
no daemon. 

Vll-5.3.5 Getting Information About a Job's Local Memory 

To obtain information about the current status of a job's local memory, call 

SRO_Mgt . Read_SRO_inf ormation. 

VII-5.4 Summary 

• Active memory consists of primary memory and swap space. 

• A node's active memory contains objects used by executing programs. 

• A one-to-one mapping exists between local SROs and jobs. 

• Most active objects are allocated from local SROs. 

• Global memory is allocated from global SROs. 

• There are two types of global SROs: frozen global SROs and normal global SROs that 
indicate whether reclamation and compaction is allowed in global memory. 

• Garbage collection can be configured for objects allocated from local SROs; it has certain 
trigger values that initiate a daemon process used to reclaim space. 
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This chapter describes how to build a type manager for stored objects. The type manager has 
the following characteristics: 

• Objects can be passivated. 

• Transactions ensure the consistency of passive versions. 

• The multiple activation model is used. 

• Objects should not be used by concurrent processes in one job. 

The techniques necessary are illustrated by way of an implementation of the 
Account_Mgt_Ex example introduced in Chapter VII-3. The example used in this chapter 
has an interface identical to the one previously discussed. This is reflected by the fact that the 
Ada specification is identical for both packages. In addition to the packages described here, 
there is another implementation of Account_Mgt_Ex provided in Appendix X-A. That im- 
plementation is slightly simpler and does not provide transaction-oriented calls. The 
transaction-oriented implementation for stored accounts will be referred to simply as the im- 
plementation of Account_Mgt__Ex. If any other implementation is referred to, that fact will 
be explicitly stated. (All example packages used in this chapter can be found in in Appendix 
X-A.) 

This chapter is self-contained. It explains all techniques necessary for building a type manager 
for stored objects. It does not, however, discuss the fundamentals of the type manager model. 
If you do not know or understand the type manager model of protection, please read Chapters 
VII-1 and VII-3 before reading this chapter. 

VII-6.1 Concepts 

Active memory is the immediate working space of the processors in one node. Active memory 
is (relatively) small, volatile, and local to a node. Passive store is not limited in size, per- 
manent, and global to a distributed system. Objects that should survive shutdowns or system 
crashes, or that should pass between node boundaries, have to be passivated. A type manager 
that stores its objects is distributed by virtue of the distributed nature of passive store. 

VII-6.1 .1 Storing and Retrieving Objects in Passive Store 

All objects are created as active objects. Local active objects disappear when the creating job 
finishes. Global active objects survive as long as the system is up. Objects have to be pas- 
sivated explicitly. Objects that have been passivated pass transparently between passive store 
and active memory. 

Objects can be labeled active-only. Active-only objects cannot be passivated. 

A job retrieves a stored object either transparently by supplying an AD or explicitly through a 
directory pathname. A job can also explicitly request that its current active version be updated 
from the passive version. 

To remove an object that has been passivated, both the active version and the passive version 
have to be removed. Passive versions have always to be removed explicitly. Deallocating an 
object's active version has no effect on any existing passive version. 
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VII-6.1.1.1 Lifetime Requirements 

Objects have a type defined by a Type Definition Object (TDO). The TDO acts as a label for 
the type and it holds information specific to the type. An object may also have an attribute list. 
The lifetimes of TDO and attribute list should be at least as long as the object's own lifetime. 
For this reason TDO and attribute list have to be passivated before any object is passivated. 

An object that has not explicitly been assigned a TDO or whose TDO has been removed is 
assigned the generic TDO by default This may have certain undesirable consequences. For 
more details refer to Section VII-6.1.2. 

VII-6.1.1.2 Storing Objects Requires Three Steps 

Storing an object for the first time requires three steps: 

• TDO and attribute list is stored. If the TDO already exists this step is omitted. 

• An AD is stored on the volume set where the object is to be stored. This AD can be stored 
in a directory or in another object. It will become the stored object's master AD. Master 
ADs cannot reference across volume sets. 

• The object's representation is stored. 

Once an object has a passive version, only its representation has to be updated if changes to the 
active version have been made. Note, that changes to an active version do not become per- 
manent until the passive version has been updated. 

vn-6.1.1.3 Object Trees in Passive Store 

Master ADs can be stored inside other objects. Thus hierarchical trees of passive objects can 
be created where one object holds master ADs for objects one level below. Object trees can be 
copied, and updated as one unit. Activating the root object of an object tree does not activate 
all the objects in the tree. Only the root object will be activated and all its ADs converted from 
passive to active form. 

VII-6-1 .2 The Type Manager Can Customize Passive Store Operations 

A type manager can supply its own routines for certain passive store operations thus customiz- 
ing passive store. The mechanism behind this feature is an attribute call. For more details on 
attribute calls, refer to Chapter VII-4. 

Passive store provides pairs of calls, operation and Reque st _operation calls. Direct calls, 
such as Update, require representation rights, while Request_operation calls, such as 
Reque st_Update, generally require only type rights. One exception are generic objects 
which require read representation rights for Request_operation calls. (The BiiN™ 
Operating System acts as a type manager for these objects.) 

If upon invoking any Reque st_operation call you receive the 

System_Exceptions . insuf f icient_rep_rights exception, this is an indication 
that something has gone wrong with your TDO. It probably means that either the TDO could 
not be retrieved because you had insufficient rights to it or that it has been deleted altogether. 
Remember though that the type manager has total control over what actually happens when 
Reqaest_operation is called. (The type manager could conceivably require rep rights for 
these operations.) 



Building Type Managers for Stored Objects VII-6-3 



1" M\&LtM.lYUU.1i\M\ X 



If a type manager does not exlicitly provide an implementation for a Request_operation call, 
the call is mapped by passive store to the direct call. This makes the direct call accessible with 
only type rights. Therefore, if any particular passive store operation should be disabled, an 
implementation of the corresponding Request_operation operation that refuses the opera- 
tion, by raising an exception, for example, has to be provided. Otherwise the operation will be 
available to anyone with type rights. 

VII-6.1 .3 Synchronizing Access to Objects - Transactions and Semaphores 

The use of transactions in passive store operations ensures that the stored data is consistent 
even in the event of system failures. Transactions also coordinate between different jobs 
accessing an object in passive store. Passive store operations either participate in a caller's 
default transaction, or a transaction is started for the duration of the call to passive store. 
Transactions have a built-in blocking protocol that avoids circular blocking of transactions. 

Semaphores coordinate access to active objects, typically between processes inside one job. If 
in the object layout a locking area has been provided, passive store transparently creates a 
semaphore upon activation. A process can also explicitly create a semaphore. This is necessary 
if the object has never been passivated or is active-only. Semaphore locking is not used in the 
example described in this chapter. For more details on semaphore locking refer to Chapters 
VM,VI-2,andVni-l. 

It is important to note the conceptual difference between transaction locking and semaphore 
locking. Transaction locking directly locks an object. While a transaction holds its lock it 
blocks all others that request access. Sempahore locking relies on voluntary compliance by all 
participating processes. Semaphore locking is therefore used primarily to coordinate between 
related processes, for example inside one job. 

Vll-6.2 Techniques 
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Packages Used: 

Ac ce s s_Mgt Interface for checking and changing rights in access descriptors. 

Attribute_Mgt Provides a way to define general-purpose operations supported by multiple 
object types or objects, with different type-specific or object-specific im- 
plementations. 

Author it y_List_Mgt 

Provides Calls to manage authority lists and to evaluate a caller's access 
rights to objects protected by authority lists. 

Directory_Mgt Manages directories and directory entries. 

Identification_Mgt 

Provides operations to manage IDs and ID lists. 

Ob j e ct_Mgt Provides basic calls for object allocation, typing, and storage management 
Defines access rights in ADs. 

Pass ive_St or e_Mgt 

Provides a distributed object filing system. 

Transact ionJMgt 

Provides transactions used to group a series of related changes to objects 
so that either all the changes succeed or all are rolled back. 

Us er_Mgt Provides calls to manage a user's protection set and user profile. 



This section describes the techniques necessary for a complete implementation of a type 
manager. The example described in this chapter and the example described in Chapter VII-3 
share the same specification. Therefore, please refer to Chapter VII-3 for the following tech- 
niques: 

• Defining the public type 

• Defining type rights 

• Defining exceptions 

• Defining the private types 

• Binding to a stored TDO. 

VII-6.2.1 Defining the Type's Calis 

The implementation described in this chapter provides the same calls as the one discussed in 
Chapter VII-3. Some calls work a little differently, though: 

I s_account Checks whether an AD references an account 

Create_account 

Creates an account. Caller is responsible for storing the account. 

Cr eat e_stored_ac count 

Creates and stores an account. Caller supplies a pathname that is not al- 
ready in use. 

Get_ba lance Returns an account's current balance. 

Change_balance 

Adds or substracts an amount from the account's current balance. 
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Transfer Transfers amounts between accounts. Transfer either completes or fails as 

a unit. 

Destroy_account 

Removes an account's active and passive versions. May leave a master 
AD behind. 

The implementation of the Is _type call will not be discussed here as it is identical to the one 
discussed in Chapter VH-3. For details, refer to that chapter. 

VII-6.2.2 Implementing the Create_account call 

The Create_account call allocates an object of the right size and type, initializes the 
representation and returns an AD with no rep rights. 

Calls Used: 

Ob jectJMgt .Allocate 

Allocates an object of specified size and type. 

Ob ject_Mgt .Deallocate 

Removes an objects active version. 

Access_Mgt .Remove 

Removes rights on an AD. 



The following excerpt from the implementation of Account_Mgt_Ex shows all the steps in 
the Create account call: 
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107 begin 

108 — 1. Check the initial balance: 
109 

110 if starting_balance < Long_Integer_Defs.zero then 

111 RAISE insufficientjbalance; 
112 

113 else 

114 — 2. Allocate and initialize the account object: 
115 

116 account_rep_untyped := Ob ject_Mgt .Allocate ( 

117 size => (account_rep_object'size + 31) /32, 

118 tdo => account_TDO) ; 

119 begin 

120 — Inside this block it is guaranteed 

121 — that the object has been allocated. 

122 account_rep.all := account_rep_object' ( 

123 balance => start ing_balance) ; 
124 

125 — 3. Remove rep rights for the exported AD: 

126 

127 account_untyped := AccessJMgt .Remove ( 

128 AD => account_rep_untyped, 

129 rights -> Object_Mgt.read_write_rights) ; 
130 

131 exception 

132 — 4. If any exception occurs, abort any local 

133 — transaction, deallocate the account, 

134 — and reraise the exception: 
135 

136 when others => 

137 Ob ject_Mgt. Deallocate (account_untyped) ; 

138 RAISE; 
139 

140 end; 

141 

142 RETURN account; 

143 

144 end if; 

145 end Create_account; 

Ob j e ct Mgt . Allocat e is used to allocate an object of the right size and type. This call 
can be substituted by the Ada new function if the BiiN Ada allocat e_with pragma is 
specified with the private object type. 

As can be seen from the above example, the Cxea.te_object call does not passivate the new 
object. It is the caller's responsibility to store the object Note also, that if an exception occurs 
during the call after the account has been allocated, it will be deallocated and the exception 
reraised. 

VIf-6.2.3 Implementing the Create_stored_account Call 

The Create_stored_account call allocates an object of the right size and type, stores a 
master AD under a pathname provided by the caller, updates the passive version, and returns 
an AD with all type rights and no rep rights. This call illustrates all steps necessary in storing 
an object. In addition, you will learn how to employ transactions to protect passive store opera- 
tions. 
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Calls Used: 

Ob ject_Mgt .Allocate 

Allocates an object of the right type and size. 

Ac ce s s_Mgt . Remove 

Removes rights. 

Transaction_Mgt . Get__def ault_transaction 
Gets the caller's default transaction. 

TransactionJMgt . Start_transaction 
Starts a local transaction. 

Transaction__Mgt . Abort_transaction 

Aborts a transaction. Rolls back any changes done by transaction oriented 
calls within the transaction. 

Transaction_Mgt . Commit__transaction 

Commits a transaction. Finalizes changes made within the transaction. 

Directory__Mgt . Store 

Stores an AD with a pathname. 

Passive__Store_Mgt . Update 

Updates a passive version. 



The Create_stored_account call allocates an object and removes rights on the exported 
AD the same way the Create_account call does. 

VII-6.2.3.1 Starting, Commiting, and Aborting a Transaction 

All passive store operations in this call are enclosed in a transaction, either a caller's default 
transaction, or a local transaction. The following excerpt from the implementation of 
Account_Mgt_Ex illustrates the use of a local transaction. 

219 — 4. Start a local transaction if there is not 

220 — a transaction on the stack: 
221 

222 if Transact ion_Mgt .Get_default_transaction = 

223 null then 

224 Transact ion_Mgt .Start_transact ion; 

225 trans := true; 

226 end if; 

227 begin 

241 if trans then 

242 Transaction_Mgt .Commit_transaction; 

243 end if; 

244 exception 

24 5 — 8. If any exception occurs, abort any local 

24 6 — transaction, deallocate the account, 

247 — and reraise the exception: 

248 

24 9 when others => 

250 if trans then 

251 Transact ion_Mgt .Abort_transaction; 

252 end if; 

253 Ob ject_Mgt. Deal locate (account_untyped) ; 

254 RAISE; 
255 

256 end; 

This technique avoids starting a local transaction if the caller already supplied a default trans- 
action. Subtransactions should be avoided, unless specifically needed. 
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The above example also indicates the use of a program block to control the scope of the 
exception handler. Within this block one can assume that, if trans is true, a local transaction 
has indeed been started. 

VII-6.2.3 2 Storing the Master AD 

The next step in storing the object is to store the master AD. The following excerpt from the 
implementation illustrates the call to Directory_Mgt. 

230 Directory_Mgt. Store ( 

231 name => master, 

232 object => account_untyped, 

233 aut => authority) ; 

master is a text record that contains the pathname to store the account. The pathname must 
reference an existing directory and not be in use. If the caller did not specify an authority list, 
authority is null, and the target directory's default authority list will be used, if one exists. 
Otherwise the caller's default authority list will be used. If no default authority list is found, 
the exception Directory_Mgt . no_def ault_authority_list is raised. 

VH-6.2.3 3 Updating the Object 

In the last step the object's representation is stored by calling 

Passive_Store_Mgt . Update: 

237 Passive_Store_Mgt .Update (account_rep_untyped) ; 

Note, that storing the AD does not passivate the object's representation. If you omit this last 

step, a later attempt to retrieve the object will result in the 

System_Exceptions . ob ject_has_no_representation exception being raised. 

VII-6.2.4 Implementing the Change_balance Call 

This call is a typical example of a type-specific operation. It illustrates the use of transactions 
to coordinate access to the passive version of an object between different jobs. 

Calls Used: 

Access_Mgt . Import 

Checks and amplifies rights on an AD in one step. 

TransactionJMgt . Get_def ault_transaction 
Returns the caller's default transaction. 

Transact ion_Mgt . Start_transaction 
Starts a local transaction. 

Transact ion_Mgt . Abort_transaction 
Aborts a transaction. 

Transaction_Mgt . Commit_transaction 
Commits a transaction. 

Passive_Store_Mgt . Reserve 

Reserves a passive version of an object on behalf of a transaction. 

Passive_Store_Mgt . Update 

Updates an object's passive version. 
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Two steps are necessary before any operations can be performed on the object; the type rights 
have to be checked on the AD supplied by the caller, and representation rights have to be 
amplified. The following excerpt from the implementation illustrates the 
AccessJMgt . Import call mat performs these two steps together: 

400 account_untyped := AccessJMgt . Import { 

401 AD => account_untyped r 

402 rights => change_rights, 

403 tdo => account_TDO) ; 

If the AD 's type rights are insufficient, this call will result in the 
System_Exceptions . insuf f icient_type_rights exception being raised. 

Before checking for a sufficient balance in the account, the technique described in the previous 
section is used to ensure that there is a default transaction. Next, the call reserves the passive 
version on behalf of the transaction: 

412 Passive_Store_Mgt .Reserve (account_untyped) ; 

The Passive_Store_Mgt . Reserve call may have three different outcomes: 

• The object is available. The call succeeds and locks the object on behalf of the default 
transactioa 

• The object is locked by another transaction. The blocking protocol permits blocking. The 
call blocks until the object becomes available. 

• The object is locked by another transaction. The blocking protocol does not allow blocking. 
The call returns with the 

System_exceptions .transaction_timestamp_conf lict exception. 

You have to be prepared to handle this exception. The technique used here is illustrated by the 
following excerpt from the implementation: 



405 


loop 


406 


if Transaction_Mgt.Get_default_transaction = 


407 


null then 


408 


Transact ion_Mgt.Start_transact ion; 


409 


trans := true; 


410 


end if; 


426* 


exception 


427 


when System_Exceptions. 


428 


transaction_timestamp_conflict => 


429 


if trans then 


430 


Transact ion_Mgt .Abort_transaction; 


431 


else 


432 


RAISE; 


440* 


end; 


441 


end loop; 



The Passive_Store_Mgt . Reserve operation is enclosed in a program block that has an 
exception handler for the transaction_timestamp_conf lict exception. The block in 
turn is enclosed in a loop that repeats the Reserve call until it succeed in either blocking or 
reserving the object 

You can avoid the Reserve call. In that case, if the object had been updated by another job 

while your call was holding it, passive store would raise the 

Passive_Store_Mgt . outdated_ob ject_version exception. You would handle the 

exception, request a fresh active version, by calling 

Passive_Store_Mgt . Reset_active_version, redo the changes, and try another up- 
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date. This technique is not acceptable for our example, since it might result in the decision, 
whether the balance be changed, being based on an outdated balance. 

VII-6.2.5 Implementing the Transfer Call 

The Transfer call is similar in nature to other type-specific calls. It is discussed in more 
detail here, since it gives another example of how transactions can be used to keep data in 
passive store consistent. 

Calls Used: 

Access_Mgt . Import 

Checks and amplifies rights on an AD in one step. 

Transact ion_Mgt . Get_def ault_transaction 
Returns the caller's default transaction. 

Transact ion__Mgt . Start_transaction 
Starts a local transaction. 

Transaction_Mgt . Abort_transaction 
Aborts a transaction. 

Transaction_Mgt . Commit__transaction 
Commits a transaction. 

Passive_Store_Mgt . Reserve 

Reserves a passive version of an object on behalf of a transaction. 

Passive_Store_Mgt . Update 

Updates an object's passive version. 



You might think that the Transfer call is superfluous, since two successive calls to 
Change_balance would achieve the same outcome. This is only partly true, as the 
Transfer call, as described here, enforces atomicity of the transfer. This means, transactions 
ensure the call cannot charge one account and not credit the other. 

First, both ADs, for the source and the destination account, are checked and amplified using 
the one-step Access_Mgt . Import call: 

494 

495 source_untyped := Access_Mgt. Import ( 

496 AD => source_untyped, 

497 rights => change_rights, 
4 98 tdo => account_TDO) ; 

499 dest_untyped :=• Access_Mgt. Import ( 

500 AD => dest_untyped, 

501 rights => change_rights, 

502 tdo => account_TDO) ; 

Next, the call makes sure that there is a default transactioa Note, that if the caller already 
started a transaction, no further transaction is needed. 

The call reserves both objects. Time stamp conflicts are handled the same way as described in 
the previous section, with a program block with exception handler inside a loop. The following 
excerpt illustrates the two Reserve calls. 

511 Passive_Store_Mgt .Reserve (source_untyped) ; 

512 Passive_Store_Mgt .Reserve (dest_untyped) ; 
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Note that if the first Reserve succeeds but the second one fails, Reserve will be called 
again on both objects. At that point the Reserve call on the first object simply results in no 
operation. 

After both objects have been reserved, the balances are checked. As the following excerpt 
shows, an insufficient balance in either account will will cause the 
insuf f icient_balance exception to be raised. 

513 if source_rep. balance - amount < zero 

514 or else 

515 dest_rep. balance + amount < zero 

516 then 

517 RAISE insufficientjbalance; 
518 

519 else 

520 source_rep. balance := 

521 sour ce_rep. balance - amount; 

522 dest_rep. balance := 

523 dest_rep. balance + amount; 

524 Passive_Store_Mgt .Update (source_untyped) ; 

525 Passive_Store_Mgt .Update (dest_untyped) ; 

526 if trans then 

527 Transact ion_Mgt .Commit_transact ion; 

528 end if; 

529 RETURN; 
530 

531 end if; 

The last step in a successful completion of the call, as shown in the example above, is to 
update both objects. The new balances do not become permanent until both objects have been 
successfully updated and the default transaction committed. Note, that even though the vari- 
ables source_rep_balance and dest__rep__balance have been assigned the new 
balances, this has no effect on the passive versions of the objects unless they are updated from 
the active versions. 

VII-6.2.6 Implementing the Destroy^ account Call 

The Destroy_account call destroys an account's passive version, and removes the master 
AD if it is stored with a pathname. 

Calls Used: 

Access_Mgt .Import 

Checks type rights and amplifies rep rights in one step. 

Transact ion_Mgt . Get_def ault_transaction 
Returns the caller's default transaction. 

Transact ion_Mgt . Start_transaction 
Starts a local transaction. 

Transaction_Mgt . Abort_transaction 
Aborts a transaction. 

Transact ion_Mgt . Commit_transaction 
Commit a transactioa 

Direct or y_Mgt . Ge t_name 

Returns the pathname of an object's master AD. 

Directory_Mgt . Delete 

Deletes a directory entry. 
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Destroy_account uses the same techniques described in the previous sections to amplify 
rights on ADs and keep data in passive store consistent The following example illustrates that 
after reserving the object's passive version, then if the balance in the account is zero, it calls 
Passive_Store_Mgt . Destroy to remove the object's passive version. If the object has 
no passive version, then the Passive_Store_Mgt . no_master_AD exception is raised. 

621 P as si ve_Store_Mgt .Reserve (account_untyped) ; 

622 if account_rep. balance /= 

623 Long_Integer_Defs.zero then 

624 RAISE balance_not_zero; 
625 

626 end if; 

627 Passive_Store_Mgt . Destroy (account_untyped) ; 

Finally the call attempts to remove the object's master AD. The following excerpt illustrates 
how: 



629 


loop 


630 


declare 


631 


path_text : System_Def s . text (path_ 


632 


begin 


633 


Directory_Mgt . Get_name ( 


634 


obj => account_untyped, 


635 


name => path_text ) ; — out . 


636 


if path_text . length > 


637 


path_text .max_length then 


638 


— Text was lost. Retry: 


639 


path_length := pa th_text. length; 


640 


else 


641 


Directory Mgt .Delete (path text); 


642 


EXIT; 


643 




644 


end if; 


645 


exception 


64 6 


when Directory Mgt.no name => 


647 


EXIT; 


648 




64 9 


end; 


650 


end loop; 



If the master AD is (1) not stored in a directory, or (2) is stored in a standalone directory that 

does not have an associated name mapper, or (3) is stored in a standalone directory whose 

associated name mapper does not support Get_name, the call to 

Directory_Mgt . Get_name may fail and return with the Directory_Mgt . no_name 

exception. 

Note that path length has an initial value of 60. In the event that the pathname is longer 
than 60 characters, the loop body will be executed again, and this time around the 
path_text text record is declared with the actual length of the pathname. 

In the last step the master AD will be deleted by calling Directory_Mgt . Delete. A 
master AD for the object may remain if other directory entries on the same volume set 
references the object. One of these alias AD will then become a new master AD. 

VII-6.2.7 Initializing the Type Manager 

In Section VII-6. 1.1.1 we have discussed the need of the TDO to outlive any of its objects. For 
this reason the TDO has to be created and stored before the first call to this implementation of 
Account_Mgt_Ex. The TDO can be created either by the system administrator using the 
configure utility at node initialization time or by a separate procedure. In this chapter we 
shall discuss the second alternative. For more details on the first alternative, refer to the BUN™ 
Systems Administrator's Guide. 
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Calls Used: 

Ob ject_Mgt .CreateJTDO 

Establishes a new type by creating a new type definition object (TOO). 

Attribute_Mgt . Store_attribute_f or_type 
Stores an attribute with a TOO. 

Transaction_Mgt . Get_def ault_transaction 
Returns the caller's default transaction. 

Transaction_Mgt . Start_transaction 
Starts a local transaction. 

Transact ion_Mgt.Abort_transaction 
Aborts a transaction. 

Transact ion_Mgt . Commit_transaction 
Commit a transaction. 

Directory_Mgt . Store 

Stores an AD with a pathname. 

PassivejStore_Mgt . Request_jupdate 

Requests an update of a passive version. No rep rights required. 



The example described in this section is the Stored_Account_TDO_Init_Ex procedure. 
(The complete code of this procedure can be found in Appendix X-A.) This procedure has to 
be executed before Account_Mgt_Ex can be linked. Note also, that a TOO uniquely iden- 
tifies its type. Calling the initialization procedure creates a new TOO that defines a new dis- 
tinct type. You have to make sure that at any time there is only one passive version of the TOO 
on the system and that all instances of Account_Mgt_Ex refer to the same TOO, otherwise 
these instances will not be compatible. 

The following excerpt from the Stored_Account_TDO_Init_Ex procedure shows how 
to declare the TOO and an instance of the passive store attribute. 

52 account_TDO : Ob ject_Mgt . TDO_AD ; 

53 ■ — TDO for accounts. 
54 

55 passive_store_impl : 

56 Passive_Store_Mgt .PSM_attributes_AD; 

57 — Implementation of passive store attribute 

58 — for accounts. 

The next step is to create the TDO, to dynamically allocate an instance of the passive store 
attribute, to initialize the instance, and to store it with the type: 
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93 passive_store_impl := new 

94 Passive_Store_Mgt ,PSM_attributes_ob ject; 
95 

96 passive_store_impl.reset := 

97 Refuse_reset_active_version_Ex. 

98 Refuse_reset_active_version' subprogram_value; 
99 

100 passive_store_impl.copy_permitted := false; 
101 

102 AttributeJMgt . Store_attribute_f or_type ( 

103 tdo => accountJTDO, 

104 attr_ID => Passive_Store_Mgt .PSM_attributes_ID, 

105 attr_impl => Untyped_from_PSM_attributes ( 

106 passive_store_impl) ) ; 

107 type_name_impl := Account_Type_Name_Ex'package_value; 
108 

109 Attribute_Mgt . Store_attribute_f or_type ( 

110 tdo => account_TDO, 

111 attr_ID => Type_Name_Attribute_Ex. 

112 Get_type_name_attr_ID, 

113 attr_impl => type_name_impl ) ; 

Note that the passive_store_impl . reset variable is initialized with a pointer to a 
subprogram that executes when 

Passive_Store_Mgt . Request_reset_active_ver sion is called. The following 
exceipt from the Ref use_reset_active_version_Ex package in Appendix X-A 
shows this procedure: 

11 procedure Ref use_reset_active_version ( 

12 obj: System. untyped_word) 

13 is 
14 

15 — Function: 

16 — Handles requests to reset an account's active 

17 — version by refusing such requests. 
18 

19 

20 begin 

21 

22 RAISE System_Exceptions.operation_not_supported; 

23 

24 end Refuse_reset_active_version; 

Note, that this procedure simply raises the 

System_Exceptions . operation_not_supported exception. 

In addition, the copy_permitted boolean is set to false. This prevents a caller to duplicate 
accounts. The Attribute_Mgt . Store_attribute_f or_type links the instance of 
the passive store attribute to the TDO. This operation does not, however, passivate the attribute 
instance. The next exceipt from the initialization procedure shows how the TDO and the at- 
tribute instance are explicitly stored: 
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122 if Transaction_Mgt.Get_default_transaction = 

123 null then 

124 Transact ion_Mgt . Start_transaction; 

125 trans := true; 

126 end if; 
127 

128 begin 

129 Directory_Mgt. Store < 

130 name => account_text, 

131 object ==> Untyped_from_TDO(account_TDO) , 

132 aut => authority) ; 

133 Passive_Store_Mgt .Request_update ( 

134 Untyped_f rom_TD0 (accountJTDO) ) ; 

135 Passive_Store_Mgt .Request_update ( 

136 Untyped_f rom_PSM_attributes ( 

137 passive_store_impl) ) ; 

138 Passive_Store_Mgt .Request_update ( 

139 type_name_impl) ; 
140 

141 if trans then 

142 Transact ion_Mgt . Commit_transaction; 

143 end if; 

144 exception 

145 when Directory_Mgt .entry_exists => 
14 6 if trans then 

147 TransactionJMgt .Abort_transaction; 

148 end if; 
149 

150 when others => 

151 if trans then 

152 Transaction_Mgt .Abort_transaction; 

153 end if; 

154 RAISE; 
155 

156 end; 

Note again the use of transactions to ensure consistency of passive store. 

VII-6.2.8 Protecting the Type Manager 

Recall for a moment two premises of the type manager model: 

• A type manager protects objects of its type. 

• A type manager provides black box type functionality. 

In order for your type manager to accomplish these requirements you have to properly protect 
it from other programs. There are two aspects to protecting the type manager, namely 

• protecting the type manager inside a running program, 

• protecting the type manager's private ADs, 

Calls Used: 



Author it y_List_Mgt . Create_authority 
Creates an authority list 

Identif ication_Mgt . Get_user_ID 
Returns caller's user ID. 



Protecting the type manager inside a running program is equivalent to protecting its address 
space. The BiiN™ Systems Linker provides special support for linking modules so that each 
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one executes in its own protected address space, called domain. Besides creating an executable 
program, you can also create an image module with the linker. Image modules are pre-linked 
pieces of software that are not linked to a user's program until runtime and that can be shared 
by several users. An image module always executes in its own domain. For more details on 
domains and image modules, in particular on how to build domains and image modules with 

TM 

the linker, refer to the BUN Systems Linker Guide. 

Depending on how your type manager is to be used, you can choose to either link it in the 
standard way to an interactive interface, or to link it into an image module, thus making it 
available to be called by user programs. If the type manager consists of small routines that are 
not going to be called very often, the savings of shared code will not outweigh the overhead of 
creating an image module. For large programs used frequently, however, using image modules 
could result in substantial savings. 

The second aspect of protecting the type manager is to protect its private ADs. It is necessary 
for the protection mechanism here that the linking not be left to the user for the following 
reason: As mentioned above, you need to create and store the TDO before invoking the type 
manager for the first time. The TDO is created by an initialization routine that stores it with a 
pathname. This directory entry is protected by an authority list. The following excerpt from 
Stored_Account_TDO_Init_Ex is an example where the authority list includes only the 
caller. 

64 owner_only: User_Mgt . protect ion_set (1) ; 

65 — Protection set that includes only one ID, namely 

66 — the type manager's owner. 
67 

68 authority: Authority_List_Mgt.authority_list_AD; 

69 — Authority list that contains only one ID, namely 

70 — the type manager's owner. 

115 owner_only. length := 1; 

116 owner_only. entries (1) .rights := User_Mgt .access_rights' ( 

117 true, true, true); 

118 owner_only. entries (1) .id := Identification Mgt.Get user id; 
119 

120 authority := Authority_List_Mgt.Create_authority (owner_only) ; 

129 Dir ectory_Mgt. Store ( 

130 name => account_text, 

131 object => Untyped_from_TDO(account_TDO) , 

132 aut => authority) ; 

The TDO is retrieved at link-time using the Ada pragma bind. At that time rights are 
evaluated against the ID list of the calling process. The following excerpt from the implemen- 
tation shows this: 

52 accountJTDO: constant Object_Mgt.TDO_AD := null; 

53 — This is a constant AD but not really null; its 

54 — filled in with an AD retrieved by the linker. 

55 pragma bind(account_TDO, 
5 6 "account"); 

57 — Bind to TDO for accounts. 

With the TDO thus protected, only people who are included in the TDOs authority list can link 
the program since noone else has access to the TDO. In the above example this is only you. 
(You could also create a separate ID just to protect the type manager.) 

After the program is linked, it can execute with any ID. 
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VII-6.3 Summary 



In this chapter you have learned the techniques necessary to build a type manager for stored 
objects. In particular, you have learned that 

• before the first object can be stored, a TOO has to be created and stored together with a list 
of attributes. 

• storing an object requires two steps, namely storing the AD and updating the object's 
representation. 

• the use of transactions keeps passive store consistent even in the event of a system failure. 

• transactions can be used to synchronize access to passive objects. 

• removing an object that has been passivated requires three steps, namely, deallocating the 
active version, destroying the passive representation, and deleting the master AD. 

• special features of the linker and pragma bind can be used to protect the type manager. 



NOTE 

Please keep in mind that the example described in this chapter permits processes in dif- 
ferent jobs to concurrently use the objects of one type. There is no provision in the 
example for processes within one job to concurrently access one object For details on 
how to achieve that, see Chapter VHM. 
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A configuration is an arrangement of objects representing the hardware and software resources 
of a particular BiiN™ node. System administrators routinely manage node configuration using 
the configure utility as described in the BUN™ Systems Administrator's Guide. Two 
classes of programmers also need to understand system configuration: 

• Programmers adding hardware devices to BiiN™ systems 

• Programmers adding software services with unique initialization requirements. 

A BiiN™ system provides a variety of predefined system configurations describing systems 
covering the most common customer characteristics of hardware configuration: number of 
users, interactive or batch workload, or computational or I/O emphasis. Any of these 
predefined configurations may be used for generating a tested and balanced BiiN Operating 
System configuration, or may be modified to accommodate site-specific requirements. 

Packages Used: 

Configuration Provides operations for creating and modifying a system configuration. 



Configuring a system includes creating configurable objects to represent hardware and 
software system components, then attaching and starting the objects to build a running system. 
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VII-7.1 Creating a Node's Configuration 

A node's configuration is created when the node is booted (see Figure VII-7-2). Booting a 
node begins with all hardware connections made, power on, and needed boot images but no 
software active in the system. Booting ends with a functioning, active system ready to respond 
to commands. The boot process must search for and initialize hardware and software modules 
and create the complex network of objects on which a running node depends. 
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Figure VII-7-2. Booting a Node 



Certain information must be available when a node is configured: 

• What objects are part of the configuration. For example, there may be objects that 
represent physical I/O devices, device controllers, logical devices such as volume sets, and 
software units such as the OS kernel. 

• One-time operations to be performed. For example, a hard disk may need to be formatted. 

• The sequence in which operations should be performed. For example, a volume set cannot 
be created on a hard disk until after the disk controller is started and the disk is formatted. 



VII-7.2 Defining a Node's Configuration 



A node's configuration is defined by a System Configuration Object (SCO). An SCO provides 
information needed to create the configuration: the objects involved, the operations involved, 
and the required sequence of operations. 

An SCO is a list of operations to perform, along with parameters for each operation. Only 
those operations defined by the Configuration . Ops attribute package are allowed in an 
SCO. If an object type needs to actively participate in the configuration process, that type 
must support the configuration attribute. Such objects are configurable. 



VII-7.3 Configuration Attribute Calls 

The configuration attribute provides calls for: 

• Attaching objects to configurable objects 

• Starting configurable objects. 
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These calls are normally used within an SCO. Other configuration attribute calls, for 
detaching objects from configurable objects and stopping configurable objects, are normally 
not used within an SCO. 



VII-7.4 Creating Configurable Objects 

System configuration is the specification of environmental hardware and software operating 
parameters of the components to be supported by a BiiN™ Operating System kernel image. 
System components include hardware modules (disk, controller, bus, etc.) and software 
modules (loadable, non-resident subsystems and optional support services). 

A configurable object (CO) is a representation of a hardware or software module that must be 
configured at node initialization, or can be dynamically added to a running node. A 
configuration attribute supports the configuration of objects other than software services, par- 
ticularly hardware components. A service configuration attribute supports the configuration of 
software services that have configuration and initialization dependencies in common. (An 
object is configurable only if its TDO contains the configuration or service configuration 
attribute.) 

A configurable object must be created for each system component to be included in a system 
configuration. After it is created, it is not yet functional, but may be attached to other con- 
figurable objects. Attachment binds the configurable objects so they can be started and placed 
in a usable state. 

When the configurable objects are no longer required to provide their function, they can be 
stopped. When they are no longer needed in the configuration, they are detached from other 
configurable objects to which they may have been attached. 

Figure VII-7-3 illustrates the process of creating a configurable object 
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Figure VII-7-3. Creating Configurable Objects 
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An object to be made configurable must have a TDO which contains a configuration attribute. 
The TDO contains a command definition that defines the type of information required by a 
configurable object of the TDO's type. This command definition is displayed in an interactive 
form through which a user enters parameter data. The data collected by the interactive form is 
extracted from the command definition format and is used to create a configurable object. 

VII-7.5 Attaching Objects to Configurable Objects 

Attach and Detach operations bind and unbind configurable objects. These configurable 
objects are considered head or tail objects depending on their relationship in the binding. 

A head object is the initiating member of a pair of configurable objects associated with each 
other. A head object is characterized by its ability to function normally without being attached 
to another configurable object. 

A tail object is the dependent member of a pair of objects associated with each other. A tail 
object is characterized by the requirement to be bound to a configurable object before it can 
become functional. Rights that may be needed on tail objects should be specified by the type 
manager supporting the Attach and Detach configuration calls on the tail objects. Tail 
objects don't have to be configurable when the attachment is unidirectional (tail object at- 
tached to head object but head object not attached to the tail object). 

An attachment normally indicates that the tail object depends on the head object to function. 
For example, a volume set must be attached to a disk in order to function. A type manager's 
implementation of Attach normally checks the validity of the attachment by checking the 
type, rights, and state of the tail object and the rights and state of the head object. 

An implementation of Attach can be bidirectional, making the attachment in the reverse 
direction as well. A bidirectional implementation is used when configurable objects are 
mutually dependent. For example, a CP (channel processor) and a SCSI (Small Computer 
System Interface) bus must communicate with each other in both directions and therefore 
require a bidirectional implementation of Attach. 

VII-7.6 Configuring Software Services 

A configurable object is an object whose TDO contains an instance of a configuration attribute. 
Kernel, loadable, and application services require an attribute that can deal with the interdepen- 
dencies inherent between them. For example, the object service uses the distribution service 
which in turn uses the clearinghouse service. An attribute is provided by configuration that, 
for example, enables the distribution service to ensure that the object service is started only 
after the Clearinghouse is started. 

The mechanism used to support this binding of services is the service configuration attribute. 
This attribute allows a service to link itself with all the necessary and optional services that it 
uses. This attribute is extensible in that it allows a service to support the initialization of 
services that use it, and allows a service's initialization to itself to depend on other services. 
This attribute registers a distribution service-dependent initialization procedure. These 
procedures are called by the BiiN™ Operating System after the system SCO has been 
processed when a node is present in a distributed system. 
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VII-7.7 Starting Configurable Objects 

All configurable objects provide Start and Stop implementations (which can be null). 
Start places a configurable object into a usable state by performing local initialization. 
Start is called by OS initialization as specified in a System Configuration Object (SCO). 
Start can also be called to start a component in a running system. Starting a configurable 
object should not start any attached tail objects. However, Start may require that tail objects 
be already started. 

When the object to be started is a configurable object (CO) or a software service (SS) that 
neither is dependent on another software service nor is depended on by another software ser- 
vice, Start places it into a usable state by performing local initialization. 
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Figure VII-7-4. Simple Attach 



When the object to be started is a software service that is dependent on another software 
service, Start performs local node initialization and attaches the first software service to the 
service on which it is dependent 
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Figure VH-7-5. Attaching to a Dependent Software Service 

When the object to be started is a software service that another service depends on, start 
performs back attaches, that is, attaches the dependent service to the service that it depends on. 
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Figure VH-7-6. Back Attachment of a Dependent Software Service 

When the object to be started is a software service (A) that is both dependent on another 
software service (B) and another service (C) depends on it, Start first attaches A to B on 
which it is dependent, and then performs back attaches from A to C. 
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Figure VII-7-7. Compound Attachment 



The order of attaches caused by starting a software service is implementation-dependent. 



VII-7.8 System SCOs and User SCOs 



A System Configuration Object (SCO) is composed of a sequence of commands that attach 
COs together and start COs. The system administrator specifies a system SCO and a user SCO 
to use during OS initialization. A system SCO references hardware and software components 
of the configuration that are required to complete the node's initialization of the BiiN™ Operat- 
ing System. A user SCO references components of the configuration that are not required to 
complete initialization of the OS, such as starting login services, database systems, specific 
application programs, and other activities that depend on disk write access or distributed sys- 
tem services. 
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Figure VII-7-8 illustrates system and user SCOs: 



/sys/scos/system_sco 



system SCO 



attach CP scsi_bus 
attach scsi_bus scsi_cntlr 
attach scsi_cntlr scsi_disk 

• • • 

start CP 

start scsi_bus 

start scsi__cntlr 

start scsi_disk 



/sys/scos/user_sco 



user SCO 



start login 
start dbms 



Figure VII-7-8. System Configuration Objects 



The order of initialization of configurable objects is defined by the sequence of Start calls in 
the SCOs. The sequence for other configurable objects started after system initialization is 
determined by their type managers. For example, a set of configurable objects that is part of a 
CP (Channel Processor) subsystem can be started by starting the configurable object that 
represents the CP. Conversely, various network services require a separate start for each ser- 
vice specified in the configuration. 

All system and user SCOs on a node are contained on the system volume set in the directory 
/sys/scos. 

VII-7.9 The configure Utility 

Additional system configuration can be performed dynamically when the system is up and 
running, or at the next boot by updating or creating new SCOs. 

The configure utility provides runtime commands to dynamically attach, detach, start and 
stop COs, and to create COs and SCOs for use at a future system initialization. See the BUN™ 
Systems Administrator' s Guide for information about the configure utility. 



VII-7.10 Summary 



• Hardware components and system software modules are defined to represent a working 
system. 

• A running system can be modified with the configure utility to build a site-specific 
system. 
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System configuration is the specification of environmental hardware and software operating 
parameters of the components to be supported by a BiiN™ Operating System kernel image. 

System configuration is the process which brings a nonfunctional system to the point that it 
can execute a common application. 

System components include hardware modules (disk, controller, bus, etc.), and software 
modules (loadable, nonresident subsystems, and optional support services). 

A configurable object (CO) is a representation of a hardware or software module that must 
be configured at node initialization or can be dynamically added to a running node. 

A System Configuration Object (SCO) is composed of a sequence of commands that attach 
COs together and starts COs. 

When a system is up and running, additional system configuration can be performed 
dynamically, or at the next boot by using the configure utility. 

A service configuration attribute enables a service to link itself with all the necessary and 
optional services that it uses. 
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Part VIII 

Distribution Services 



This part of the BUN™/ OS Guide describes OS support for distributed services. 

The chapters in this part are: 

Understanding Distribution 

Explains basic concepts of distribution and distributed services. 

Building a Distributed Type Manager 

Explains how to build a local single-activation distributed type manager, 
using remote procedure calls. 

Distribution Services contains the following services and packages: 

clearinghouse service: 

CH_Admin 
CH_Client 
CH_Support 
Node_ID_Mapping 

RPC service: 

RPC_Admin 

RPC_Call_Support 

RPC_Mgt 

transport service: 

Comm_Defs 

Datagram_AM 

DG_Filter_Mgt 

Distributed_Service_Admin 

Distributed_Service_Mgt 

ISO_Adr_Defs 

ISO_Config_Defs 

ISO_TM_Admin 

TM_Comm_Defs 

VC_Filter_Mgt 

Virtual Circuit AM 
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VIII-1.1 Introduction 



The BiiN™ Operating System supports distributed computing. A distributed system, capable 
of distributed computing, spans a number of BiiN™ nodes connected by a communication 
network. The network may contain several subnetworks. In this context a subnetwork is a 
homogeneous network such as ethernet or HDLC. It is important to note that the network 
connecting a distributed system need not be homogeneous. Two distributed system may also 
share a homogeneous subnetwork, such as a LAN (local area network), for example. Distribu- 
tion is a high level concept independent of the communication media and associated com- 
munication protocols. Although distribution is independent of the communication media, it is 
optimized for high speed LAN applications. 

A distributed system may appear as a "single machine' * to the casual user. On the other hand a 
user can use his/her knowledge of the structure of the system, and work with individual or 
defined collection of components (nodes, I/O devices, and so on). 

Figure VIII-1-1 shows an example of a network of BiiN™ nodes. 
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Figure Vm-1-1. A Network of BiiN™ Nodes 



This particular network contains two bus-based LANs connected via a public packet switched 
network. Two additional subnetworks are shown, one based on a set of dedicated point to point 
communication lines and the second based on a circuit switched network. Circles indicate the 
boundaries of distributed systems. 

Distributed computing lies in between multiprocessing and networking. Table VIII- 1-1 lists 
important points in which the three concepts differ. 
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Table VEH-l-l. Distribution vs. Multiprocessing vs. Networking 



Multiprocessing 


Distributed Computing 


Networking 


Close Cooperation 
Complete Trust 

Single Administrator 
Completely Shared Resources 

"Single Machine" 


Cooperation 

Tempered Trust 
Access/Resource Controls 

Cooperating Administrators 

Controlled 
Sharing of Resource 

Homogeneous 


Mutual Suspicion 
No Trust 

Independent Administrators 
No Shared Resources 

Heterogeneous 



On one hand distribution extends the concepts of multiprocessing beyond the limits of one 
shared memory, and on the other hand distribution takes the ideas of networking one step 
further. 

This chapter explains the concepts of distribution. It does not explain specific techniques or 
point out the details of implementing a distributed service. This information is contained in 
chapter Vin-2. 

The next section gives examples of what a distributed system can do and what it cannot do. 
The following sections discuss the most important aspects of distribution in more detail, in 
particular the following topics: 

• Communications 

• Naming 

• Review of the computational model 

• Single activation distributed services 

• Protection in a distributed system 

• Transparently distributed services. 

Communications and naming are the two building blocks of the distributed architecture. For 
this reason special attention will be given to these two areas. 



VIII-1.2 What a Distributed System Can Do 

Distributed computing makes it possible to build computer systems of any size from a single 
node up to a conglomerate of as many nodes as you choose. (There is no limit to the size of a 
distributed system.) Even though only a conglomerate of individual machines, the system acts 
in many ways as if it were one single machine, provided, of course, that the communication 
media is fast enough. 

In most cases the user need not be aware of the physical organization of the distributed system; 
although nodes are individual machines that can operate by themselves, they appear to the 
casual user to be one unit. For instance, disks are mounted on individual nodes, but they 
appear to be mounted on all nodes at once. A user can also choose to run a job on a selected 
node or to store an object on a particular disk drive of his/her choice. 

Jobs are the computational unit in a distributed system. Jobs run on single nodes but they 
communicate with other jobs, on the same node or on other nodes in the system. The interface 
for job communication on different nodes and the same node is identical, but there is an ef- 
ficient implementation of intra-node communications. 
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By the means of interjob communication, independent jobs may exchange messages or related 
jobs may be coupled together. A service, such as the filing service, may contain jobs that run 
concurrently on all nodes of the system. The service is thus available on all nodes. All jobs 
belonging to the service communicate constantly and create a homogeneous environment of 
file access and usage across the entire system: Any file on the system is uniquely identified 
and stored in one place; this avoids a considerable amount of duplication. Files are available 
from any node: Requests to access a file are forwarded to the file's home node and executed 
there. 

The filing service is a universal service. Universal services are decentralized; filing requests 
are serviced on the node where the requested file is stored. Since files can be stored at any 
node, filing services requests on all nodes of the system. (Diskless nodes are currently not 
supported.) 

Services can also be regional. A regional service is centralized; requests can be issued on 
many nodes but only a few nodes (or even a single node) service requests. Universal services 
are * 'symmetric* '; on all nodes there is an agent that accepts and distributes requests and a 
server that receives requests from an agent and executes them. A regional service is 
"asymmetric"; there are many agents and only a few servers. 

Compare a universal service to the postal service: Every town has its own post office that 
receives mail from other towns, distributes it to the addressees, and collects and processes 
outgoing mail. A regional services resembles more an insurance company. Insurance agents 
sell policies for a company that underwrites the policies. The agent interacts with the clients 
on the one side and with the insurance company on the other. The insurance agent does not 
underwrite policies himself. 

As an example of a regional service imagine an airline reservation system. All booking infor- 
mation is kept in a few locations. Agents in branch offices make reservations on their local 
nodes; the requests are transparently forwarded to one of the nodes where booking information 
is kept. 

Distributed systems provide parallel processing. A session may span several nodes and contain 
jobs on all those nodes. If a task can be partitioned, processes in these jobs can work on parts 
of the task asynchronously. 

Currently, load balancing is not implemented. The architecture does not discourage this 
functionality, however. An application implemented as a distributed service can decide based 
on the load in the system, how it routes requests to its servers. An example is a distributed 
batch utility that submits batch jobs to the node with the lowest load in the system. 

The following two sections discuss the most important elements in a distributed system, 
namely how entities are named, and how nodes in the system communicate. 

Vlll-1. 3 Naming 

One of the two building blocks of a distributed architecture is a location-independent naming 
mechanism. Here is an example of the merit of location-indepent naming: A volume set is 
identified on the machine level by a unique volume set ID. The volume set ID reflects where 
the volume set is currently mounted in the system. The symbolic name of the volume set on the 
other hand has nothing to do with the location of the volume set. More importantly, the sym- 
bolic name does not change when the volume set is moved to another node. You can refer to 
the volume set without having to know where it is currently located. 
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Naming extends to stored objects, users, nodes, and volume sets. The map from machine level 
identifiers to symbolic names is maintained the clearinghouse. 

The clearinghouse centralizes network information in a few locations. Thus network infor- 
mation can be updated quickly and easily. Volume sets can be moved from one node to 
another, a node may be added, or a node may be disconnected: Those changes have to be 
recorded in only a few places, namely where copies of the clearinghouse are kept. 

VIII-1.3.1 The Clearinghouse 

The clearinghouse is decentralized and replicated. Instead of one global clearinghouse server 
there are many local servers each storing a copy of a portion of the global information. Some 
information in the clearinghouse is cached locally by other services. This allows to bypass the 
clearinghouse for efficiency and when access to a clearinghouse server is not possible due to a 
communication failure. 

User ids, for example, are available at all nodes. This is necessary in order to allow users to 
log on to a local node even if that node is disconnected from the rest of the system. The same 
applies to locally mounted volume sets. 

The organization of the clearinghouse is hierarchical. Names of clearinghouse entries consist 
of four parts representing the four level hierarchy. The names of the four parts are 
organization, domain, environment, and local. Clearinghouse names are specified with single, 
double and triple slashes between the level names. A full clearinghouse name is always of the 
following form: 

// /or g/dom/env/ local 

Organization and domain together reference a naming domain. A large distributed system 
is typically split up into multiple naming domains. Thus name evaluation does not become 
hopelessly slow when the system becomes very large. Every node in the system belongs to 
exactly one naming domain. The clearinghouse is partitioned on the naming domain level. This 
means that one clearinghouse server stores all entries of the form 

///organization/domain/anything/anything 
A name starting with two slashes reference an entry in the callers organization: 

//dom/env/local 

A clearinghouse name starting with one single slash refers to the local naming domain: 

/env/local 

Figure VIII- 1-2 illustrates the hierarchical structure of the clearinghouse. 
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Figure Vm-1-2. The Hierarchical Structure of the Clearinghouse 

The inforaiation in figure VIII- 1-2 is shown together in one place. In a real system it is 
partitioned, replicated, and stored in different locations. The figure is very much simplified and 
shows entries for only one naming domain. This is done for convenience and ease of under- 
standing. 

There is one special naming domain per distributed system, called the figurehead naming 
domain. This domain covers the entire system. More specifically, it references all other entries 
in the clearing house. In fact, the figurehead naming domain defines the distributed system. It 
is used whenever the naming domain of an object is not known. This can happen when a 
passive object is activated: Passive_Store_Mgt has a unique identifier (UID) for the ob- 
ject which contains the ID of the volume set where the object is stored. With the help of the 
figurehead naming domain, Passive_Store_Mgt maps the volume set ID to the network 
address of the node where the volume set is mounted. 

The clearinghouse is maintained by the clients, BiiN™ Operating System services or applica- 
tions that use the clearinghouse. Clients maintain clearinghouse environments. In an environ- 
ment the clients store names and properties associated with those names. The naming service, 
for example, maintains the vs environment It uses this environment to map volume sets to 
node addresses, indicating where the volume set is mounted. Another example is the protection 
service. It maintains the id environment that maps user IDs to user profiles (and thus to 
symbolic user names). This information is used by the logon utility. The distributed OS ser- 
vices use a total of four environments in the clearinghouse, namely vs, id, node, and 
ds_i<± From the point of view of the clearinghouse there is no difference between those 
environments and other environments. The clearinghouse simply provides the mechanisms for 
binding symbolic names to properties in one networkwide location. It is entirely up to the 
client to attribute meaning to the clearinghouse entries. 

Most applications will use the clearinghouse indirectly through the OS services. However, if 
the need arises, an application may use the clearinghouse directly, either through the above 
mentioned environments or even by setting up its own environment. 

A request to the clearinghouse to bind a name to a set of properties may originate anywhere in 
a distributed system. The request will be directed to a clearinghouse agent. The agent knows 
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the address of at least one clearinghouse server. The server will either handle the request 
directly or, if it does not store the required information, forward the request further to a server 
that stores the informatioa This entire process happens invisibly to the client. 

In summary the clearinghouse provides the basic tools needed for a high level naming 
mechanism. But the function of the clearinghouse goes beyond this task. Any type of infor- 
mation may be bound to a name; an internetwork address, in the case of a node, or a telephone 
number, in the case of a user. Services can use the clearinghouse to whatever purpose they 
require. The merit of the clearinghouse is that it centralizes all this information and makes it 
available to everyone. One of the most important uses of the clearinghouse is to provide loca- 
tion independent naming. 

VIII-1 .4 Communications 

If distribution is compared to a brick wall, then naming corresponds to the bricks and com- 
munications to the mortar, either one without the other would be useless. And just as mortar 
and bricks become invisible once plaster has been applied, so should the details of naming and 
communications be invisible in a distributed system. However, nobody can build a wall with- 
out mortar, and nobody can build a distributed system without communication between nodes. 
In order to understand distribution, we have to have some understanding of how nodes com- 
municate. 

One of the guiding principles in the BiiN™ architecture is that logical structures hide physical 
structures. This principle also pertains to communications: The system supports a variety of 
different communication protocols, such as Ethernet, IEEE 802.3, HDLC and X.25. Transport 
services hide the details of these various subnetworks. Through the interfaces provided by 
transport services a distributed service can use two different high level communication 
protocols, a connection oriented and a connectionless protocol. We refer to the connection- 
oriented protocol as a virtual circuit and to the connection-less protocol as a datagram. 

Datagrams are short one-way messages sent from one job to another. They are similar to letters 
sent through the mail: There is no guarantee that a datagram sent will be received by the 
addressee or that a number of messages sent will be received in the order that they were sent. 
Transport services only guarantee that if a message is received, it will be intact. On the 
positive side datagrams are inexpensive (just as letters), fast, and require little overhead. 

Virtual circuits provide a full duplex connection between the connected parties. A virtual cir- 
cuit is a bidirectional ordered flow of bytes similar to a telephone connection. Receipt of a 
message is acknowledged and messages sent in a certain order arrive at the addressee in that 
same order. Setting up, maintaining, and tearing down a virtual circuit presents considerable 
overhead. 

There is a third way for processes to communicate. This method is called a remote procedure 
call. Remote procedure calls are built on top of datagrams and share some of the advantages of 
datagrams. They provide the following additional services: 

A simple call interface 

Making an RPC involves no more than making an ordinary procedure call. 

Authentication and security 

Messages are authenticated to insure that they are intended for that server 
and that they have not been modified in transit. 
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Converting ADs ADs are converted to their passive form. 
Locating Given an AD to the server, RPC locates the server. 

RPCs are message/reply pairs. They force the caller to wait until the call has completed. A 
series of RPCs made by one process is strictly ordered, since the calling process cannot make 
another RPC before the previous one has completed. RPCs are used within distributed services 
to communicate between instances of the service. (RPCs made by different processes in a 
certain order do not necessarily retain that order.) 

It is important to note the conceptual difference between RPCs on one side and datagrams and 
virtual circuits on the other. RPCs use datagrams as means of communication, they provide 
additional services as mentioned above, and they are not as flexible as datagrams. RPCs are 
taylored specifically to the needs of distributed services. Datagrams and virtual circuits are 
basic means of communication and not taylored to any specific application. They provide no 
locating services, no authentication, and their interface is more complicated than RPCs. In 
exchange they can be used for any type of communication between jobs, not just between 
instances of a distributed service. 

Whether an application uses RPCs, datagrams or virtual circuits depends on its particular 
needs. An application set up as a distributed service will find RPCs the easiest to use. For other 
uses datagrams or virtual circuits provide the necessary flexibility. In particular datagrams are 
good for sending brief messages, and virtual circuits for reliably transmitting large amounts of 
data. 

Figure VIII- 1-3 gives a simplified picture of the differences between datagrams, virtual cir- 
cuits, and RPCs. 



Datagrams: one— way, one— shot 
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Virtual circuits: two— way, continuing exchange 
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RPC: two-way, one— shot, like a procedure call 
Figure VHI-1-3. Three Different Communication Methods 

Both datagrams and virtual circuits link two jobs. To be more precise, datagrams are sent from 
one transport service access point (TSAP) to another. A TSAP represents a binding between 
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the user of a transport service and the transport service itself. A TS AP object represents a 
TSAP. In the case of datagrams the TSAP object also serves as a repository for information 
relating to the TSAP that it represents. This includes buffers and state information. TSAPs are 
specific to either datagrams or virtual circuits. 

In the case of a virtual circuit there is an additional, dynamic level of association between 
communicating processes, the connection. A transport connection point (TCP) represents an 
endpoint of the connection. In this case the TSAP represents only the static binding between 
user and transport service and is used to create and destroy TCPs which represent the dynamic 
binding. Multiple TCPs can be associated with one TSAP (but only one TSAP with any TCP). 

TSAPs are bound to a TSAP address. A TSAP address uniquely identifies a TSAP over the 
entire network. A user who wants to send data through his TSAP to another TSAP must know 
the TSAP address of the destination TSAP. The remote user can receive the data on his TSAP 
along with the sender's TSAP address. 

TSAP addresses are composed of two parts, a network part which uniquely identifies an in- 
stance of the transport services, typically associated with one node, and a transport service end 
point. The network part is known as an NSAP. An NSAP is the point at which an instance of 
the transport services is bound to the network level services. Inside the realm of an NSAP an 
end point uniquely identifies a TSAP. 

It is convenient for some system- wide services to reserve certain fixed values of end points. 
Those end points are called well known endpoints. Other endpoints are dynamically allocated 
by the transport services. 

Summarizing, the BiiN™ architecture provides high level interfaces for communications be- 
tween nodes in a distributed system. Depending on the needs of an application communication 
services can be used at different levels. However, at all those levels an application does not 
have to be concerned with the details of the communication protocol. 

VIII-1.5 Review of the Computational Model 

In the previous two sections we have outlined naming and communications in a distributed 
system. Those are the building blocks for a distributed architecture. In this section we shall 
review the BiiN™ computational model briefly and put it in perspective in a distributed system. 

VIII-1.5.1 Processes, Jobs and Sessions 

Processes represent linear threads of computation. Multiple processes may be part of one job. 
Jobs are the unit of program execution in the BiiN™ system. Jobs, and therefore processes, are 
confined to a single node. A session may contain many jobs on different nodes. The jobs in the 
session can communicate with each other or with jobs outside their session. In many ways a 
job acts like a virtual computer. 

VIII-1.5.2 Active and Passive ADs 

Active access descriptors (active ADs) are represented by 33bit words where the 33rd bit, the 
tag bit, is set. Active ADs are valid inside a node's active memory only. Before an AD can 
cross node boundaries in a distributed system, it has to be converted to its passive version. A 
passive AD is a much larger entity than an active AD (about 40bytes). A passive AD is a 
unique reference on all BiiN systems at all times. In order for an object to have a passive AD 
an AD to the object has to have been stored previously. 
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Vlll-1.5.3 Single and Multiple Activation Model 

The system supports two different models of activating passive objects (copying passive ob- 
jects into active memory). In the multiple activation model any job activating an object 
receives an independent active copy of the object A job can work on its copy and update the 
passive version from the active version. The multiple activation model is easy to use except for 
one problem; passive store refuses updates from outdated versions. A job whose update has 
been refused can handle this situation by requesting a fresh active version, redoing its changes, 
and attempting another update. 

The single activation model avoids the updating problem by allowing only one copy of an 
object in active memory. One job, the home job, receives the active version and all other jobs 
receive stand-ins, called homomorphs, when activating an object. Those jobs who have 
homomorphs communicate with the home job in order to effect changes on the object. The 
single activation model is useful for large objects that are used by many jobs simultaneously. 

There is an important difference between how global and local objects are treated in both the 
single and the multiple activation models. Independent of whether in the single or multiple 
activation model there is always a maximum of one active version per of node of a global 
object. All jobs accessing the global object share this one active version. In the single activa- 
tion model there is one active version of an object per distributed system, in the multiple 
activation model there is one active version per node of a global object, and one active version 
per job of a local object. Independent of the activation model processes within one job always 
share an active version 

Figure VIII-1-4 illustrates the difference between single and multiple activation model. Note 
that what is shown as active memory in the figure may span several nodes. 
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Figure VIII-1-4. Single and Multiple Activation Model 



Distributed services can be built along the lines of either activation model. Very little 
knowledge of distribution is needed in order to build a multiple activation distributed service. 
BiiN™ Operating System distributed services take care of the distribution part transparently in 
tihis case. Building a distributed service along the lines of the single activation model is more 
complicated and requires knowledge of the mechanisms of distribution and interjob com- 
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munication. In the following section we shall present the model of a single activation dis- 
tributed service. 

VIII-1.6 Single Activation Distributed Services 

There are two ways a distributed service can be set up, as a regional or as a universal dis- 
tributed service. In both cases the service contains agents and servers. Requests to the service 
are directed to an agent. The agent forwards the request to a server which executes it and 
returns the results to the agent. A universal service has servers and agents on every node of the 
system. An example of a universal service is the filing service. A regional service has an agent 
on every node but servers on only a few or even a single node. An example of a regional 
service is a print service with a printer that is mounted on one particular node, but accepts print 
jobs on any node. 

In a regional service an agent knows the address of at least one server. It does not have to 
know the address of the server that will actually execute the request; if it directs the request to 
another server the request will be forwarded until it reaches its destination. 

A distributed type manager is also a distributed service. The difference between a type 
manager and a distributed service in general is that the type manager has representation rights 
to its objects. It can therefore distinguish between homomorphs and real active versions. This 
simplifies the model somewhat: There is no need for a strict two level implementation accord- 
ing to the client/server model. In one job the same code can act as the client, in another as the 
server. The code decides what role it assumes depending on whether it was handed a 
homomorph or the real active version. If it is handed a homomorph it recognizes that it ex- 
ecutes outside the home job. In this case it will act as an agent and forward the request to the 
server. If it is handed the real active version, that means that it executes inside the home job. In 
that case it assumes the role of the server and executes the requests directly. 

VIU-1.7 Protection in a Distributed System 

Security issues constitute a considerable problem in an open network architecture. In some 
sense, communications over such a network are similar to radio broadcasts; it is impossible to 
prevent somebody from broadcasting or from listening to certain broadcasts. If you want to 
protect broadcasted messages you will have to encrypt them. 

The only security mechanisms in effect at the transport level are those that protect TSAPs. 
Three rights are defined for TSAPs: Receive, Send and Control. Receive rights are necessary 
to receive messages through a TSAP. Send rights are required to send messages through a 
TSAP. Control rights are needed to destroy or configure a TSAP. 

This protection mechanism does not prevent you from using either datagrams or virtual circuits 
to send messages to a TSAP on another node or even on your node if you have the TSAP's 
address. Validation of messages and authentication of the sender is entirely a a high level 
concern. There are two sides to this problem; on one side data in transit should be protected 
from unauthorized use. On the other side a distributed service's private ADs have to be 
protected from unauthorized use but at the same time be available to all instances of the ser- 
vice. 

Encryption protects data in transit. An application that transmits sensitive data should therefore 
encrypt that data. There are two solutions to the problem of protecting private ADs. 
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(Encrypting the data to be transmitted but not protecting private ADs would be like locking the 
door to one's house but leaving the keys in the lock.) A distributed service can set up its own 
ID (identical to a user ID). Private ADs can then be stored under well-known pathnames but 
with an authority list that excludes all IDs but the service's ID. Another solution to the 
problem is to store the private ADs inside the code of the service, more specifically inside the 
service's static data object This simple solution has the disadvantage that all instances of the 
service have to communicate when one of the private ADs changes. 

Remote procedure calls provide authentication and validation services. They also protect data 
in transit and convert active ADs to their passive version. (An AD still has to be passivated 
before being transmitted in an RPC — using an AD on another node if that AD has not been 
passivated before may have unexpected results.) 

When using datagrams or virtual circuits the user has to provide those services himself. 

VIII-1.8 Transparently Distributed Services 

The BiiN™ Operating System provides a number of transparently distributed services. With 
the help of these services a user can take full advantage of a distributed system. They can also 
be used as tools to build distributed applications. Examples of these services are the filing 
service, the object service, the concurrent programming service, and the transaction service. 

TM 

All of the BiiN Operating System's distributed services provide transparent access to an 
entire distributed system's resources. The programmer need not be aware of any of the physi- 
cal peculiarities of the system. 

In the following we shall list some of the most important distributed services: 

VIIM.8.1 Passive Store 

Passive_Store_Mgt maintains a system-wide permanent storage. Objects may be stored 
on volume sets anywhere in the system and can be retrieved from anywhere. Passive store also 
maintains unique names for all its stored objects. Those names are called unique identifiers 
(UIDs). UIDs are unique not only on one distributed system but on all distributed BiiN™ 
systems for all times. A volume set may thus be taken from one node in a system to another or 
even from one distributed system to another. Objects stored on the volume set are always 
uniquely identified. 

VIII-1 .8.2 Directories 

Directory_Mgt maintains a system-wide directory structure. Directories implement sym- 
bolic naming for stored and for active objects. Often Directory_Mgt and 
Passive_Store_Mgt will cooperate closely, the former providing the naming mechanism 
and the latter the actual storing of objects. 

However, DirectoryJMgt may stand on its own: Directory entries can reference any ob- 
ject, active objects as well as passive objects. And while most directories are stored, there are 
also active-only directories. 

The directory structure on each node replicates to a certain extent the entire naming domain the 
node belongs to. (Certain local aliases may exist on one node, so the directory trees on two 
nodes are not identical, but their structure is very similar.) The directory structure is not a 
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simple tree structure: Branches are interconnected and entries may reference backwards in the 
tree. Thus many different pathames may reference the same object 
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Figure VEH-1-5. Partial View of a Node's Directory Structure 

Figure VIII-1-5 shows a partial view of a node's directory structure. (Solid boxes are master 
entries and dashed boxes represent alias entries.) In particular it illustrates that more than one 
pathname may reference the same object. For example, /node/Castor/ sys/ sam, 
/home/sam, and /vs/vsl/sam all reference Sam's home directory. By the same token 
/home/don references Don's home directory which lives on a different node. This shows 
that objects with two similar pathnames (/home/sam and /home/don) do not have to be 
physically close to each other. 



V!fl°1.8.3 IDs 



IDs are associated with users. User IDs control access to stored objects and facilitate setting up 
individualized user environments. A user can be granted access to a distributed system by the 
system administrator. At that time the system administrator will create a user ID. A user ID 
grants access to an entire distributed system, not a particular node. Privileges, such as store 
rights for directories, are granted on a per naming domain basis. 

Every process that a user starts and every object that the user stores carries the user ID. IDs are 
maintained in the clearinghouse's id environment. 

Very similar to user IDs are subsystem IDs A subsystem ID identifies a subsystem which 
comprises a collection of domains that share the same stack. 
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There are other IDs, namely node IDs, volume set IDs, and distributed service IDs. All these 
IDs play important roles in a distributed system. Node IDs are derived from a hardware 
module inside a node. They are used in the node environment to map nodes to network 
addresses. 

Volume set IDs uniquely identify volume sets. Together with a time stamp they are incor- 
porated into unique identifiers for objects (passive ADs). Volume set IDs of volume sets 
mounted locally are cached to allow access to locally stored objects when there is no direct 
access to the clearing house. 

In summary IDs are used whenever certain entities such as users or nodes are to be uniquely 
identified within a distributed system. 



VIII-1 .8.4 Files 

Files are among the most important data structures in the BiiN™ architecture. Filing is a dis- 
tributed service. This means that any file in the system is available anywhere in the system. 

Files are global single activation objects; files are activated in only one place, namely at their 
home node. All jobs that use a particular file communicate with the home node when updating 
the file or reading from the file. Commonly files are large objects. Therefore it makes sense to 
bring the operation to the data as opposed to bringing the data to the operation. 

VIII-1 .8.5 Data Integrity, Synchronization, and Transactions 

Data integrity and synchronization across job and node boundaries can be ensured by using 
transactions. Transactions make operations atomic thus preventing partial completion of opera- 
tions: Operations included in a transaction either complete successfully or have no effect. Not 
all operations can be included in a transaction; certain operations are simply irrevocable. Print- 
ing is an example: once a page is printed it cannot be made to disappear. 

Transactions extend across node boundaries whenever transaction-oriented, distributed BiiN™ 
Operating System service calls are included in a transaction. Transactions also serve to 
synchronize access to stored objects; a transaction can reserve an object on its behalf. Then no 
other transaction can reserve or access the object until the first transaction releases it. Trans- 
actions also have a built-in blocking protocol: One transaction can wait for another transaction 
only if the other transaction is older. (This ordering prevents a circular deadlock situation.) 

VHM -9 Summary 

Reading this chapter, you have learned that 

• distribution makes a collection of BiiN™ nodes connected together, appear as one machine. 

• a distributed system is a flexible structure; nodes may be added and removed as the system 
runs. In particular, distributed services do not depend on the structure of the network that 
connects the nodes in the system. 

• logical organization hides physical organization. 

• nodes share a common pool of resources, such as I/O devices, and permanent storage. 

• distribution is transparent from the casual user's point of view. 
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PRELIMINARY 



This chapter describes how to build a distributed type manager. It focuses on the peculiarities 
of the regional service model. Other features needed for the program, such as transactions, 
passivating objects, and synchronization are described in chapter VII-6. The basic concepts of 
the type manager model are treated in chapter VII-3. 

Three packages and two initialization procedures are described in this chapter, 
Account_Mgt_Ex, Distr_Acct_Call_Stub__Ex, 
Distr_Acct_Server__Stub_Ex, Distr_acct_init_ex, and 
Distr_acct_home_ job_ex. These packages will be refered to briefly as core, call stub, 
server stub, initialization, and home job initialization. All packages and the initialization 
procedures can be found in Appendix X-A. 



VIII-2.1 Concepts 



The type manager described here manages local objects on a distributed system that may 
consist of any number of nodes grouped into any number of naming domains. Active versions 
of local objects are confined to a single job, and each job activating the object receives its own 
active version (Some of the active versions may be "ersatz' ' versions). All processes of one 
job share the job's active version. {Global objects have only one active version per node shared 
by all jobs on that node.) 

According to the single activation model, the object's representation is activated in one home 
job. All operations and all synchronization are handled by the home job. Other jobs receive 
token active versions called homomorph and do not operate on the object directly — they 
forward all requests to the home job. 

As an alternative, a type manager may use the multiple activation model: In the multiple ac- 
tivation model every job receives an active version. The multiple activation model is usually 
simpler to implement, but updating the passive version from multiple active versions has to be 
carefully coordinated. One can say that the multiple activation model brings the object to the 
operation, while the single activation model brings the operation to the object: For large ob- 
jects, such as files for example, the single activation model is more efficient. 

The node where the objects are managed is called the home node. Any node can be the home 
node. 

The example described manages simple accounts that contain a long_integer balance. 
Accounts can be stored in directories or inside other objects anywhere on the system. When 
creating an account the application supplies a pathname or an object where the account is to be 
stored. In order to minimize network traffic it is advisable to store accounts on volume sets 
mounted at the home node ~ the type manager does not enforce this, however. Independently 
of where accounts are stored they are accessible from any node of the system. 

Communications between the home job and any other jobs are implemented by means of 
remote procedure calls. For more details on the general principle of distribution and RPCs refer 
to chapter VIII- 1. 

The type manager provides the following calls: 

I s_account Checks whether an AD references an account. 

Great e_account 

Creates an account and stores it inside an object supplied by the caller. 
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Create_stored_account 

Creates an account and stores it with a pathname supplied by the caller. 

Get_balance Returns an account's balance. 

Change_balance 

Changes an accounts balance and returns the new balance. 



Transfer 



Transfers an amount between accounts. 



De st roy_ac count . 

Destroys an account 

YIII-2.1 .1 Homomorphs and Active Versions 

The type manager creates a template that is activated in place of the active version in all jobs 
but the home job. The template does not have to have the same type as the object it will stand 
for. The template merely represents a bit pattern that is copied into active memory and become 
the homomorph. Only the type manager using the representation rights can distinguish be- 
tween homomorph and active version. The type manager can use the homomorph to store 
information related to a calling job. Such information can be statistical, for example frequency 
of calls, or use of resources. 

VIII-2.1.2 The Remote Call 

A call to the type manager involves two jobs, the calling job and the type manager's server 
job. The server job is also the home job. The two jobs may live on a single node or on two 
separate nodes. 

Figure VIII-2-1 illustrates the general model of a distributed service implemented with RPCs. 




Node Home Node of "Foo" Object 

(not home node of "Foo") 

Figure VIII-2-1. General Model of Communication Using RPCs 
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A user program in the calling job holds an AD to the object called FOO. The calling job is not 
the home job of FOO objects and the AD points to a homomorph. The user program calls the 
local instance of FOO_Mgt, the type manager for FOO objects. FOO_Mgt recognizes from the 
homomorph that the job is not the home job and forwards the call to its call stub. The call stub 
packs the parameters into a message buffer and issues an RPC to the server. The initial 
program in the server is FOO_Mgt , s server stub which calls the local instance of FOO_Mgt. 
FOO_Mgt performs the requested operation and the result is returned. 

This is how the general model maps to the special case described here: Account_Mgt_Ex 
acts as the type manager's front end. It corresponds to Local Foo_Mgt in the picture. Ap- 
plications that want to use the type manager call this package. Thus the distributed implemen- 
tation looks identical from the outside to the other implementations of the account manager 
described in Chapters VII-3 and VII-6. All communication between different instances of the 
type manager on different nodes happens behind the scenes, namely in the call stub, 
Distr_Acct_Call_Stub_Ex, and the server stub, Distr_Acct_Server_Stub_Ex. 

The actual work of the type manager is done by Account__Mgt__Ex in the home job. This 
package distinguishes between objects and their homomorphs. When it encounters a real object 
its operations are identical to the ones of the package described in Chapter VII-6 except for the 
semaphore synchronization mechanism. (This happens in the home job.) When it encounters a 
homomorph it hands off the call to the call stub that takes care of the remote calling 
mechanism. (This happens in an application job.) Thus the remote calling syntax is not part of 
the type manager's core and can be easily changed without affecting the type manager. 

VIII-2.1.3 Synchronizing Access 

The single activation model centralizes synchronization in the home job. Multiple simul- 
taneous requests may be serviced by concurrent processes inside the home job. Processes in the 
home job share the active version of an account. Access to the active version is synchronized 
by semaphores. Semaphore locking relies on voluntary compliance of all processes. Processes 
that operate on an object have to call P before touching the object This will block the calling 
process if another process has locked the semaphore previously. However, nothing prevents a 
process from circumventing the semaphore mechanism altogether. 

No provisions are made to synchronize access to passive versions since according to the model 
of this distributed service there is nevermore than one active version from which the passive 
version can be updated. 

As with all locking mechanisms there is a problem of circular waiting. Transaction come with 
a built-in blocking protocol that avoids this. For semaphores the problem can be solved by 
enclosing all semaphores within transactions to use the transaction timeout to break any cir- 
cular waiting pattern. 
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Packages Used: 

Ac ce s s_Mgt Interface for checking and changing rights in access descriptors. 

Attribute_Mgt Provides a way to define general-purpose operations supported by multiple 
object types or objects, with different type-specific or object-specific im- 
plementations. 

Author it y_Li s t_Mgt 

Provides Calls to manage authority lists and to evaluate a caller's access 
rights to objects protected by authority lists. 

Directory_Mgt Manages directories and directory entries. 

Identification_Mgt 

Provides operations to manage IDs and ID lists. 

Ob j e c t_Mgt Provides basic calls for object allocation, typing, and storage management 
Defines access rights in ADs. 

Pass i ve_S t or e_Mgt 

Provides a distributed object filing system. 

RPC_Call_Support .Remote_call 

Calls a service that may be at another node. 

Semaphore_Mgt . P 

Enters / locks / waits at a semaphore. 

Semaphore_Mgt . V 

Unlocks / leaves / signals a semaphore. 

Transact ion_Mgt 

Provides transactions used to group a series of related changes to objects 
so that either all the changes succeed or all are rolled back. 

Us er_Mgt Provides calls to manage a user's protection set and user profile. 



VIII-2.2.1 Defining The Representation of The Object 

In addition to other contents the type manager's objects hold two fields: A locking area and an 
is_homomorph boolean. The locking area is needed for semaphore locking and the 
is_homomorph field allows the type manager to distinguish homomorphs from active ver- 
sions. The example from the core shows the account layout which contains the 
long_integer balance plus those two fields: 

96 type account_rep__ob ject is 

97 — Representation of an account . 



99 lock: Semaphore_Mgt . semaphore_AD ; 

100 — Locking area 

101 is_homomorph: boolean; 

102 — If false identifies the object 

103 — as the active version; if true 

104 — as a homomorph. 

105 balance: Long_Integer_Defs.long_integer; 

106 — Starting balance. 

107 end record; 

The locking area is null in the passive version but is filled in with an AD to a semaphore when 
the object is activated. 

The object layout is specified with an address clause. This is necessary since the type manager 
relies on the layout of the object in memory: Record layout in memory may vary from com- 
piler version to compiler version. 
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108 


FOR account_rep_object 


USE 






109 


record AT mod 32; 








110 


lock at 


range 


. 


. 31; 


111 


is_homomorph at 4 


range 


. 


. 7; 


112 


balance at 8 


range 


. 


. 63; 


113 


end record; 









VIII-2.2.2 Defining the Homomorph Template 

The homomorph template acts as a bit pattern that is copied into active memory in place of an 
active version. In the simplest case the template is defined with is_homomorph set to true 
while in the active version is_homomorph is false. Other information can be stored in the 
template. In particular, the type manager can use the template to store resource or statistical 
information pertaining to the calling job. The following example is from the initialization 
procedure Distr_acct_init__ex. (This procedure can be found in its entirety in Appendix 
X-A. In our example only the is_homomorph field is used. The other fields are initialized 
to null. 

90 type template is 

91 record 

92 dummy_wordO: System. untyped_word; 

93 is_homomorph: boolean; 

94 dummy_wordl : System. untyped_word; 

95 dummy_word2 : System. untyped_word; 

96 end record; 
97 

98 FOR template USE 

99 record AT mod 32; 

100 dummy_word0 at range . . 31; 

101 is_homomorph at 4 range . . 7; 

102 dummy_wordl at 8 range . . 31; 

103 dummy_word2 at 12 range .. 31; 

104 end record; 
105 

106 type homomorph_AD is access template; 

107 pragma access_kind(homomorph_AD, AD); 
108 

109 homomorph: homomorph_AD ; 

14 9 — 2. Allocate and initialize homomorph template: 
150 

151 homomorph : = new template' ( 

152 dummy _word0 => System. null_word, 

153 is_homomorph => true, 

154 dummy_wordl => System. null_word, 

155 dummy_word2 => System. null_word) ; 

Note that template does not even have the same type as the object proper. 
VIH-2.2.3 Setting the Passive Store Attribute 

In order for Passive_Store_Mgt to transparentiy substitute a homomorph for active ver- 
sions in all jobs but the home job, the homomorph field in the PSM_attributes_ob ject 
has to be non-null. If the field is not null Passive_Store_Mgt uses the AD contained in 
that field as a reference to a template to substitute for the object. The following excerpt from 
the initialization shows how the passive store attribute defined and how it is initialized: 






73 passive_store_impl: 

74 Passive_Store_Mgt .PSM_attributes_AD; 

75 — Implementation of passive store attribute 

76 — for accounts. 

145 — 1. Allocate new passive store attribute implementation: 
14 6 

147 passive_store_impl := new 

148 Passive_Store_Mgt .PSM_attributes_ob ject; 

156* 

157 — 3. Initialize passive store attribute implementation: 

158 

159 passive_store_impl.homomorph := Untyped_from_homomorph(homomorph) ; 

160 

161 passive_store_impl. reset := 

162 Refuse_reset_active_version_Ex. 

163 Refuse_reset_active_version' subprogram_value; 
164 

165 passive_store_impl.copy_permitted := false; 
166 

167 passive_store_impl.locking_area_start := 0; 

168 passive_store_impl . locking_area_end := 0; 

169 — Area in account where semaphore AD will be 

170 — stored when account is activated. 

The PSM_attributes_ob ject also specifies where the locking area is and that accounts 
cannot be copied. 

VIII-2.2.4 Defining Buffers for Remote Procedure Calls 

Buffers are necessary for both parameters and results in remote procedure calls. The following 
example from the server stub defines one buffer type for both parameters and results. 

14 type buffer is 

15 — Buffer used for remote calls. 

16 record 

17 first_word: System. untyped_word; 

18 second_word: System. untyped_word; 

19 amount: Long_Integer_Defs.long_integer; 

20 end record; 

The buffer has room for two ADs and one long_int eger. This is the maximum trans- 
mitted in one single call. (Trans f er). Note again that an address clause is used to fix the 
layout of the buffer in memory: 



23 


FOR buffer USE 












24 


record AT mod 


32; 










25 


first_word 


at 





range 


. 


. 31; 


26 


second_word 


at 


4 


range 


. 


. 31; 


27 


amount 


at 


8 


range 


. 


. 63; 


28 


end record; 













VIII-2.2.5 The is Call 



Calls Used: 



Ob jectJMgt .Retrieve_TDO 

Returns an object's type. 



No inter-job communication is necessary for the Is call: The object itself is not involved in 
the call at all: The type manager only retrieves a TDO and compares it to its own TOO. For 
this reason the the core does the work directly as can be seen in the following example: 
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139 return obj /= System. null_word 

140 and then 

141 Object_Mgt.Retrieve_TDO(obj> = account_TDO; 



VIII-2.2.6 The The Create Calls 



Calls Used: 

Transaction_Mgt . Get_def ault__transaction 

Returns the transaction on top of the transaction stack. 

Transaction_Mgt . Start_transaction 

Starts a transaction and pushes is it on the stack. 

Transaction_Mgt . Commit_transaction 
Commits a transaction. 

Transact ion_Mgt . Abort_transaction 
Aborts a transaction. 



The type manager uses the is_homomorph field to distinguish between the home job and 
any other job. This method fails with the Create_ calls since there is neither a homomorph 
nor an active version to check before the object has been created. (Remember that 
i s_homomorph is false in the home job and true in all other jobs.) 

For this reason any job can create objects. This means that in both Create^ calls the core 
does the operation directly. In order to prevent multiple active versions the new object is 
deallocated as soon as it has been created and passivated. The three steps, Allocate, Passivate 
and Deallocate are enclosed in a transaction. Thus the Creat e_ calls cannot succede par- 
tially leaving unwanted active versions. 

The following excerpt from the core shows these essential part of the Create_account 
call: 
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341 if Transaction_Mgt.Get_default_transaction = 

342 null then 

343 TransactionJMgt .Start_transaction; 

344 trans := true; 

345 end if; 
346 

347 

348 begin 

34 9 — This block controls the scope of 

350 — the exception handler. 

351 

352 — 5. Create the master AD: 

353 

354 Directory_Mgt. Store ( 

355 name => master, 

356 object => account_untyped, 

357 aut => authority) ; 
358 

359 — 6. Passivate the representation of the account: 

360 

361 Passive_Store_Mgt .Update (account_rep_untyped) ; 

362 

363 — 7. Deallocate the active version of the 

364 — account: 
365 

366 Ob ject_Mgt .Deallocate (account_rep_untyped) ; 

367 

368 — 8. Commit any local transaction. 

369 

370 if trans then 

371 Transaction_Mgt .Commit_transaction; 

372 end if; 
373 

374 exception 
375 

376 — 9. If an exception occurs, abort any local 

377 — transaction, deallocate the account and 

378 — reraise the exception: 
379 

380 when others => 

381 if trans then 

382 Transact ion_Mgt . Abort_transaction; 

383 end if; 

384 Ob ject_Mgt .Deallocate (account_rep_untyped) ; 

385 RAISE; 
386 

387 end; 

The type manager provides a second Create_ call named Create_stored_account. 
While the Create_account call simply allocates a new account, the 
Create_stored_account also stores the account with a pathname supplied by the caller. 
The calling mechanism is identical to the Create_account call and the operation proper in 
the core is identical to the one described in Chapter VII-6. 

VIII-2.2.7 Implementing Calls that Require Remote Calls 

Except for the three calls discussed in the previous sections, namely Is_account, 
Create_account, and Create_stored_account, all calls of the type manager require 
remote calls. The remote call has the same calling syntax for jobs on one node and for jobs on 
different nodes. When a remote call is needed the core hands it off to the call stub that takes 
care of it. 
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VHI-2.2.7.1 Recognizing the Home Job 

The is_homomorph field is used to recognize the home job. hi the home job the type 
manager will see is_homomorph as false, in any other job as true: 

458 if account_rep.is_homomorph then 

459 

460 — 2. We have a homomorph: 

461 

468 else 

469 

470 — 3. We are in the home job for accounts: 

471 

530 end if; 

When is_homomorph is true a remote procedure call has to be made and the core hands the 
call off to the call stub. When is_homomorph is false the operation can be done directly. 

Vm-2.2.7.2 Making the Remote Procedure Call 

Calls Used: 

RPC_Call_Support .Remote_Call 

Makes an RPC to an RPC service. 



A remote procedure call is a means of communication between two jobs. All information 
passed between the jobs is contained in buffers. 

Both the caller and the callee have to agree on the format of the buffers. Once transmitted to 
another job a buffer is no more than a pattern of bits that has to be interpreted correctly. Two 
buffers are required, one for parameters and one for results. This is shown in the following 
example from the call stub: 

72 parameters, results: Distr_Acct_Server_Stub_Ex. buffer; 

For the type declaration of buffer refer to section VIII-2.2.4. Before the call the calling job 
packs parameters into the buffer and after the call results are unpacked from the results buffer: 

82 parameters := Distr_Acct_Server_Stub_Ex. buffer' { 

83 first_word => account_untyped, 

84 second_word => System.null_word, 

85 — irrelevant 

86 amount => Long_Integer_Def s.zero) ; 

87 — irrelevant 

101 current_balance := results. amount; 

The layout of the buffer is designed for maximum required size. Not all slots are needed in all 
calls. 

When making a remote call the calling job specifies the service to be called. This directs the 
call to a server job where the service is currently registered. Optionally a node ID can be 
specified in the call. This will direct the call to the server on the specified node. This option 
can be used when multiple servers exist and one in particular is to be chosen. 

calls are assigned an ordinal value and depending on the value of tr aget_ proc in the call 
the associated procedure or function in the main package is called. 
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In the case of our example the assignments are as follows: 

Used to initialize the server job. 

1 Get_balance. 

2 Change_balance. 

3 Transfer. 

4 Destroy_account. 

Note that Is_account, Create_account, and Create_named_acount are not as- 
signed an ordinal value. These functions are always performed locally and do not require a 
remote call. 

The addresses and sizes of the buffers are also specified, and a boolean parameter is used to 
indicate that ADs are being transmitted. ADs have to be converted in a remote call. Indicating 
that no ADs are present speeds up the call. 

The following example shows the syntax of the remote call: 

91 length := RPC_Call_Support.Remote_call ( 

92 service => service, 

93 target_proc => 1, 

94 param_buf => parameters' address, 

95 param_length => parameters' size, 

96 ADs_present => true, 

97 results_buf => results' address, 

98 results_length => results' size) ; 

As you can see from the above assignments this remote call will result in Get_balance 
being called by the server. The variable length contains the actual length of the results 
buffer. This is useful when the result buffer's length varies. The variable is not used here since 
the results buffer in this example has a fixed length. In order to see where service comes 
from refer to section Vm-2.2.9.3. 



Vffl-2.2.7.3 The Server Stub 



Calls Used: 



RPC_Mgt . Server_stub 

Template for a stub procedure to be called by the server. 



When the server is called it executes an initial procedure called the server stub. The procedure 
declaration of the server stub matches a template, namely RPC_Mgt . Server_stub. The 
type manager provides the implementation of the template. The declaration looks like this: 



21 


procedure server_stub ( 






22 


target_proc : 






System. short_ordinal; 


23 


version: 






System . ordinal ; 


24 


param_buf : 






System. address; 


25 


param_length : 






System. ordinal; 


26 


results_buf : 






System. address; 


27 


results_length : 


in 


out 


System. ordinal; 


28 


ADs_returned ; 




out 


boolean) 



Depending on the value of target_proc the server stub interprets the parameter buffer and 
makes the requested call. In the example the server stub is coded with a case statement: 
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59 case target_proc is 

77 when 2 => account_one__untyped := parameters. first_word; 

7 8 amount : = 

7 9 Account_Mgt_Ex . Change_ba lance ( 

80 account => 

8 1 account_one , 

82 amount => 

83 parameter s. amount ) ; 

84 results := buffer' ( 

85 first_word => System. null_word, 

86 — irrelevant. 

87 second_word => System. null_word f 

88 — irrelevant. 

89 amount => amount) ; 

90 AD s_re turned := false; 

117 when others => 

118 RAISE System_Exceptions.operation_not_supported; 

119 end case; 

Note that the server stub calls the core. This does not result in an infinite loop by triggering 
another remote call since this call takes place inside the home job. The core performs the 
requested operation and returns the result 

VIII-2.2.8 Synchronizing with Transactions and Semaphores 

Access to account objects is centrally synchronized in the home job. In the home job multiple 
concurrent processes may access an account. Concurrent processes in the home job use 
semaphore locking to reserve the active version of an account More details on synchronization 
and semaphore locking can be found in Chapters VI- 1 and VI-2. 



• 



• 



Access to the passive version of an account is not synchronized since no more than one 
active version of an account exists. Here lies one of the advantages of the single activation 
model. 

Transactions are used to prevent semaphore deadlock and to protect passive versions from 
incomplete updates. Please note that the transaction timeout period is set when the system 
is configured. 

Outside the home job no synchronization is required since object representations are never 
touched outside the home job. 



VUI-2.2.9 Initialization 

This type manager is a distributed service and spans at least two jobs. Two procedures are 
needed to initialize the type manager, Distr_acct_init_ex, and 
Distr_acct_home_ job_ex. Both procedures can be found in Appendix X-A. 

The following three points should be considered when the service is initialized: 

• Depending on how the service is set up it may or may not create a lot of network traffic. 
The worst possible situation arises when the type manager's image module is stored on one 
node, the stub on another, the home node is still another node, and accounts are stored all 
over the network. Objects should be stored close to the home node, ideally on the home 
node itself. 

• The type manager model of protection can only be fully realized if the code is linked into 
its own separate domain. In particular, the type manager's private ADs are hidden in the 

TM 

static data object with the help of the BiiN Ada pragma bind at link-time. Therefore the 
static data object should not be accessible to any other module but the type manager. 
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• As part of the initialization the server is created and installed. When installing the server the 
caller can specify an SSO from which the server is scheduled and a cpu time limit. If those 
parameters are not explicitly specified (as in our example) the server is allocated from the 
caller's SSO and inherits the caller's time limit. For this reason the type manager should be 
installed from a privileged ID. Otherwise the server may experience resource exhaustion at 
some unexpected time. 

Vm-2.2.9.1 Private ADs are Hidden in the Static Data Object 

The ADs for the TDO and the service are stored in the type manager's module, more precisely 
the static data object This is necessary since these objects are created by the 
Distr_acct_init_ex procedure and stored with an authority list that includes only the 
developer thus making them inaccessible to the user of the type manager. They are retrieved 
when then type manager is linked. For this reason linking has to be done with the developer's 
ID. A third AD, the one for the homomorph, is stored by the Di st r_acct_init_ex 
procedure in the passive store attribute. 

The objects referenced by these ADs should only be created once. For example: One type is 
identified by exactly one TDO. There cannot be two TDOs referencing the same type. By 
definition two objects referencing different TDOs have different type. (If a TDO is destroyed it 
can of course be replaced by a new one.) By the same token there is only one distributed 
service, and one homomorph template. Fortius reason Distr_acct_init_ex should only 
be executed once on a distributed system, prior to linking the type manager. Then, after the 
type manager has been linked, Distr_acct_home_ job_ex should be executed to initial- 
ize the server. 

After these steps have been executed the main package can be called by an application. The 
following sections explain the steps in the initialization: 

Vm-2.2.9.2 Creating the Server 

Calls Used: 

RPC_Mgt . Create_RPC_server 

Creates an RPC server. 

RPC_Mgt . Install_server 

Installs an RPC server and returns an AD to the server job. 



The following call creates a server on the local node: 

61 server: constant RPC_Mgt.RPC_server_AD := 

62 RPC_Mgt.Create_RPC_server; 

63 — Server for accounts. 
64 

65 server_job: Job_Types. job_AD; 

66 — Installed server job. 

193 — 7. Install server: 
194 

195 server_job := RPC_Mgt . Install_RPC_server { 

196 server => server) ; 

Four optional parameters can be specified with the call (default values are given in 
parentheses): A maximum (2) and a minimum (2) number of processes for the server, a 
maximum number of services (1) that can be registered with the server, and a naming domain 
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with which the server will associate, (naming domain of the creating node). Note that two 
steps have to be taken to create the server, first it has to be created, second it has to be 
installed. Installing the server creates the server job. This example package should first be 
called by a job with unlimited resources, or an unlimited SSO should be specified in this call. 

VIII-2.2.9.3 Creating and Registering the Service 

Calls Used: 

RPC_Mgt . Create_RPC_service 

Creates an RPC service and returns an AD to the service. 

RPC__Mgt .Register__RPC_service 

Registers a service with a server. More than one service can be registered 
with one server. 



An RPC service is transparently accessible. That means that the caller does not have to know 
the physical address of the server, but can specify the service and the call will be routed 
transparently. The service is not automatically associated with a server. In order to bind a 
service to a server the service has to be registered with the server. Multiple services can be 
registered with one service. Exactly how many is determined by the max_services 
parameter in the RPC_Mgt . Create_RPC_Server call. The following excerpt from the 
initialization shows these two calls: 

198 — 8. Create the service: 
199 

200 service := RPC_Mgt .Create_RPC_service ( 

201 server => server); 
202 

When registering a service the caller specifies a stub procedure. That stub procedure matches 
the RPC_Mgt . Server_stub template. The server executes the stub procedure registered 
with one service when it receives a remote call from that service. 

Vm-2.2.9.4 Setting Up the Home Job 

Calls Used: 

Passive_Store_Mgt . Set_home_job 

Establishes the calling job as home job for objects of one type. Undoes the 
effect of any previous call by another job. 



Before the service can be called the server has to become the home job for account objects. 
This is achieved by executing the Distr_acct_home_ job_ex procedure. The following 
excerpt shows this procedure in its entirety: 
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27 begin 

28 — Set up server as home job 

29 — by calling procedure "0": 
30 

31 parameters : = Distr_Acct_Server_Stub_Ex. buffer' ( 

32 first_word => account_TDO_untyped, 

33 — account TDO 

34 second_word => System. null_word, — Irrelevant. 

35 amount => Long_Integer_Defs.zero) ; 

36 — Irrelevant. 
37 

38 length := RPC_Call_Support .Remote_call ( 

39 service => service, 

40 targetjproc => 0, 

41 — Server will call Passive_Store_Mgt .Set_home_job. 

42 param_buf => parameters 'address, 

43 param_length => parameters' size, 

44 ADs_present => true, 

45 results_buf => results' address, 

46 results_length => results' size) ; 
47 

48 end Distr_Acct_Home_Job_Ex; 

This procedure makes a remote call specifying as the target procedure. In turn, the server 
stub which is running in the server job calls Passive_Store_Mgt . Set_home_job when 
is specified as the target procedure: 

59 case target_proc is 

60 when => account_TDO_untyped := parameters. fir st_word; 

61 Passive_Store_Mgt . Set_home_job ( 

62 tdo => account_TDO) ; 

63 ADs_returned := false; 

119 end case; 

Note that the Passive_Store_Mgt . Set_home_ job procedure has to call and cannot 
call Set_home_job directly since only the server executes exclusively in the server job. 
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From this chapter you should have learned how to build a distributed type manager. The ex- 
ample described has the following properties. 

• The type manager acts as a distributed service. 

• Objects are managed in one home job. 

• Local instances of the service communicate with the home job by remote procedure calls. 

More specifically you should have learned how to 

• set up the object's representation including a locking area and an i s_homomorph field. 

• initialize the passive store attribute to implement the single activation model. 

• define a template that is activated instead of the object's active version in all jobs but the 
home job. 

• define buffers for remote calls. 

• create and install the server. 

• create and register the service. 
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• define the call stub. 

• recognize a homomorph. 

• pack and unpack buffers. 

• make remote calls. 
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Part IX 

Device Services 



This part of the BUN™/ OS Guide provides information about device drivers and device 
managers. This part contains one chapter: 

Understanding Device Managers and Device Drivers 

Describes the low-level I/O model and general architecture of device 
managers and drivers. 

Device Services contains the following services and packages: 

Device driver service: 

CP_IO_Defs 

CP_Mgt 

CP_Re sources 

DD_Support 

Handl ing_Suppor t 

Interrupt_Handling_Support 

IO_Messages_Defs 

IO_Messages_Ops 

Region_3_Support 

SCS I_Bus_Dependent_De f s 

SCSI_Record_Defs 

shared queue service: 

Cluster_Service 
IO_Shared_Queues 

asynchronous communication service: 

Async_Def s 

mass storage service: 

Bus_Independent_Disk_Defs 
Bus_Independent_Streamer_Defs 
Bus_Independent_Tape_De f s 
Mass_Store_Reply_Codes 
MS_Conf iguration_Defs 

SCSI service: 

CP_SCSI_Defs 

CP_SCSI_Mgt 

SCS I_Bus_Dependent_De f s 

subnet service: 

Carrier_Mgt 

Subnet_CL_AM 

Subnet_CO_AM 

Subnet_Defs 

Trace_Defs 

T r a c e_S uppo r t 

HDIC service: 

HDLC_Mgt 

LAN service: 

CSMA_CD_Defs 

E t he r ne t_LAN_Mgt 

IEEE8023 LAN Mgt 
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This chapter describes device manager and device driver architectures. 

Packages Used: 

IO_Messages_Defs 

Defines the I/O messages mechanism interface. 

IO_Mes sage s__Ops 

Provides driver-independent I/O message calls for device drivers. 

Cluster_Service 

Manages cluster servers. 

IO_Shared__Queues 

Defines the shared queues I/O mechanism. 

Port_Mgt Provides fast interprocess communication within a job. 

CP_Mgt This package defines the types used in communicating with a Channel 

Processor (CP). This includes the format of various data structures used 
by a Channel Processor. Furthermore, the Send_to_CP operation is 
defined here. It forwards an I/O message to a Channel Processor for ser- 
vice. 

DD_Support Supports device drivers. 

Interrupt_Handling_Support 

Manages interrupt handlers. 

Handling_Support 

Provides calls to save and restore global registers. 

Region_3_Support 

Provides a call for installing macrocode in Region 3. 

Un saf e_0b j ect_Mgt 

Provides special object allocation and deallocation calls. 

Countable_Object_Mgt 

Supports type managers of countable global objects. 



The relationship between an application, a device manager, device driver and a device is 
shown in Figure IX- 1-1. 
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Figure IX-1-1. Device Environment 



IX-1.1 Concepts 



This section introduces methods, concepts and terminology necessary for understanding the 
role of device managers and device drivers in communicating with devices. 

A typical I/O process involves the following actions: 

• A device object is opened by an application using an Open access method call prior to 
sending data to a device. 

• An I/O data transfer mechanism combined with a device class forms an I/O interface 
through which the device manager can communicate with a device driver, a CP (Channel 
Processor), and ultimately a device. 

This chapter describes two I/O data transfer mechanisms which may be used to form an I/O 
interface, and describes the roles of device managers and device drivers. 



IX-1.2 I/O Model 



The primary elements of the I/O model are device objects, device managers and opened device 
objects. A device object is a typed object that represents a device. A single device object is 
associated with each device in the system. A device manager is a type manager that controls 
access to a device. Devices include files, magnetic tapes, terminals, and pipes. An opened 
device object is a typed object that represents a input/output connection between a device 
manager and a device. Zero, one or more opened device objects may exist for the same device. 
Opened device objects are analogous to I/O channels on other systems. 
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IX-1.2.1 Access Methods 



Applications interact with device managers via access methods. An access method is a collec- 
tion of procedures which provide a device-independent interface to perform I/O. A device 
object has associated with it the implementations of the access methods supported by that 
device. An access method is a type attribute of device objects and opened device objects. 

To perform device operations, an application selects an access method and passes a device 
object to its Open operation. Open returns an opened device object representing an opened 
device channel. The opened device object is passes as a parameter when making access 
method calls. 

A device can be simultaneously accessed by more than one access method. This is convenient, 
for example, when a call is made to a library function that internally uses a different access 
method. 



IX-1 .2.2 Device Managers 



A device manager is a type manager of a specific type of device which provides a high-level 
interface through which an application can communicate with a device. 
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A device driver provides a device manager with access to a physical device. In the BiiN 
Series 60/80, a device driver is connected to its device through a CP. Device drivers are 
simplified by being connected to a CP since drivers do not need to provide such functions as 
handling interrupts and issuing device commands. 

IX-1 .2.4 Device Classes 

A device class is a specification which defines the device-specific details necessary to access a 

class of device using an I/O mechanism. Device classes are used by device managers and 

implemented by device drivers. Device class specifications provide opening parameters 

(initial values for the IO_Shared_Queues . device_state_rep), command codes used 

in the Common Part of the I/O message 

(IO_Messages_Def s . IO_message . command_code), and reply codes used in the 

Common Part of the I/O message 

(IO___Messages_Def s . IO_message . reply_record). A device class specification 

used with an I/O mechanism forms a device-specific I/O interface through which device 

managers and device drivers may communicate on behalf of devices of the device class. 

IX-1 .2.5 I/O Mechanisms 

The BiiN Operating System defines two I/O mechanisms available to device drivers: 

• I/O messages 

• Shared queues. 

I/O messages supports high-speed, block-oriented data transfer, shared queues supports low- 
speed, character-oriented data transfer. These design characteristics make the I/O messages 
mechanism more suitable for disk I/O and network communications, and the shared queues 
mechanism more suitable for I/O to terminals. 
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Although these mechanisms are designed to provide communications between device 
managers and device drivers, they may also be used for device managers to communicate with 
other components such as other device managers. For example, a terminal might be connected 
to a system via a terminal concentrator on a network. The terminal device manager could use 
the shared queues mechanism to talk to a software component that converts the shared queues 
protocol to subnet message-based requests. 

These mechanisms provide data transfer. The I/O messages mechanism is also used in an 
administrative interface. 

IX-1 .2.6 The I/O Messages Mechanism 

The I/O messages mechanism consists of operations that device managers can call to support 
data transfer, including administrative functions, with high-speed, block-oriented devices such 
as disks, tapes and high-speed communications. 

The I/O Message 

An I/O message is an object consisting of four parts: 

• Common part 

• Device Driver part 

• Device Manager part 

• Buffer Description part. 

The Common part of the I/O message has fields at fixed offsets that are visible to device 
managers, device drivers and CPs. It contains information about an I/O request including the 
type of request, the device involved and the number of buffers associated with the message. 

The Common part contains pointers, offsets and IDs for locating the reply mechanism, the 
physical device, the CP, the beginning of the buffer description array and the Common part 
itself. Other fields identify the type of reply mechanism used, usage information about the 
buffer descriptions, request and reply priorities, error ID, command code and any device- 
specific parameters. 

The Device Driver part follows the Common part, is variable in size depending on the device 
class, and is reserved for use by device drivers and CPs. 

The Device Manager part follows the Device Driver part, is variable in size depending on the 
device class and is reserved for use by the Device Manager. 

The Buffer Description part contains an array of buffer descriptions. Each buffer description 
contains the size and address of its buffer and use indicators. Since this array does not begin at 
a fixed location within the message, the Common part contains an offset field with which 
device drivers and device managers can locate the beginning of the array of buffer descrip- 
tions. 

I/O messages may have several buffers. The buffers must be allocated in frozen memory. A 
device manager must not modify the buffers between the time a request is issued and the time 
the I/O message is returned to the device manager. 

The contents of a buffer depend on the type of request and the device class associated with the 
I/O message. (The semantics assigned to each request are described in the device class 
specification/package.) Some I/O messages might not reference any buffers at all, such as a 
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device-specific reset request. Other requests such as a Read normally require at least one 
buffer. 

Reply Mechanism 

The device manager decides the reply mechanism, interrupt reply procedure or reply port from 
which it will receive its returned I/O messages. The selected mechanism is specified by the 
values in reply_port__or_j>roc and type__of_reply. 

The interrupt reply procedure is called by an interrupt handler, and performs post-processing 
of the serviced I/O message such as setting error_id and t otal_returned__length. 
A template for this procedure is provided via 

IO_MessagesJDef s . Process_IO_jnessage. The reply port mechanism is an inter- 
process communications mechanism on which I/O messages can be enqueued. 

The interrupt reply procedure has the advantage of not causing a context switch, but does 
execute an interrupt handler. Thus the implementation of an interrupt reply procedure must 
comply with all constraints placed on interrupt handlers (see 

TM 

Interrupt_Handling_Support for a list of interrupt handler constraints). Most BiiN 
Operating System device managers use the I/O reply port mechanism. 

IX-1.3 Data Transfer Via the I/O Messages Mechanism 

Most systems will employ CP-connected devices because I/O via CPs is available and efficient 
for the more common protocols (see BiiN /OS Reference Manual for a list of supported 
devices). Using a CP also greatly simplifies the tasks which must be performed by a device 
driver. 
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Figure EX-1-2. Device Driver using the I/O messages Mechanism 

Data transfer to a CP-connected device using the I/O messages mechanism can be done via the 
following steps: 

1. The application calls an access method Open to create an opened device. 
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2. The device manager allocates the data buffers and buffer descriptions (optionally using 
DD_Support . Set_buf f er_description), and fills in the following fields: 

queuing__space 

reply_j?ort_or_proc 

total_request_length 

type_of_reply 

reply_j?riority 

io_msg 

used_buf f ers, optional 

max_buffers 

c ommand_co de 

buffer_descr_off set 

device_specific_params 

The device manager may optionally allocate a pool of I/O messages by repeatedly creating 
I/O messages and calling DD_Support . Register_IO_message. A pool of I/O mes- 
sages may be shared by several devices. 

3. The device manager calls IO_Mes sages_Ops . Ops . Is sue_request to forward the 
I/O message to a device for service. 

4. Any time after the I/O message has been sent to the device (Step 2), the device manager 
calls Port_Mgt .Receive or Port_Mgt . Conditional_receive to receive the 
message from the reply port, if a reply port was selected as the reply mechanism. If the 
selected reply mechanism is an interrupt reply procedure the message receipt method is be 
defined by the procedure. 

5. The device driver gets access to the I/O message, and fills in the following fields of the 
Common part of the I/O message: 

• phys_dev 

• request_jpriority, optional 

• cp_id 

• device_id 

The device driver also fills in the following fields defined in the Device Driver part of the 
I/O message required by the GP: 

• interrupt_q_addr 

• phys_buf_desc_addr 

inter rupt_q_addr is the physical address of an interrupt queue head. It identifies the 
return path from a CP to a CPU after the message has been serviced. 
phys_buf_desc_addr is the physical address of the buffer description array. 

The device driver can call an access method's Get_device_inf o call to acquire infor- 
mation for some of these fields. It can also place other information in the undefined section 
of the Device Driver part for its own use. 
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The device driver must set these fields because a device manager will generally use one 
pool of I/O messages to issue requests for all the devices it manages. Since a device 
manager may manage some devices that are connected to the system by CPs and others that 
are directly connected, several different device drivers may service a single device 
manager's I/O requests. They may use the Device Driver part of the I/O messages dif- 
ferently. Therefore, a device driver must set all the fields in an I/O message that specify 
device information. 

6. The device driver issues an I/O request to the CP by calling CP_J4gt . Send_to_CP. 

7. After the CP has finished servicing the I/O request, it writes the following results in the I/O 
message: 

• error_id, if an error occurred. 

• total_returned__length 

• reply__record 

8. The CP sends the I/O message to the interrupt queue specified by interrupt_q_addr 
and generates an interrupt. 

9. The CPU interrupt handler which processes CP-generated interrupts, returns the I/O mes- 
sage to the reply mechanism specified in the I/O message (Port_Mgt . Send for a reply 
port). 

10. The device manager may continue issuing requests for service, calling receive operations 
and logging any errors. 

11. When the device manager completes and needs no further access to the device, it waits for 
pending I/O requests to complete (or cancels them and calls an access method's Close to 
close the opened device. 

12. After the device manager has received the I/O messages from the reply mechanism (Step 
3), and closed all the devices that it manages, it may optionally deregister the pool of I/O 
messages with the recovery agent via DD_Support . Deregister_IO_message. 

IX-1.3.1 I/O Recovery Agent 

A recovery agent is provided on each node by the BiiN™ Operating System. This agent detects 
I/O processor failures and maintains a table of existing I/O messages. Device managers keep 
this list current by calling DD_Support . Register_IO_message each time they create 
an I/O message, and by calling DD_Support . Deregister_IO_message before they 
deallocate an I/O message. 

IX-1.4 Data Transfer Via the Shared Queues Mechanism 

The shared queues I/O mechanism is designed to handle low-speed, character-oriented com- 
munications for such devices as terminals and printers. This design minimizes context 
switches and interrupts while maintaining satisfactory response time. 

The shared queues mechanism is comprised of a cluster servers which services one or more 
clusters which contain up to eight pairs of input and output queues (circular buffers). This 
mechanism employs an input and output queue for each device. These queues are grouped into 
clusters. A cluster is a group of queues that are serviced together. A cluster represents a group 
of devices, typically those serviced by the same channel processor (CP) task. See Figure 
IX- 1-3. 
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IX-1.5 Clusters and Cluster Servers 

Clusters are configurable objects (CO) and are typically created and attached to devices during 
system initializatioa A cluster may contain shared queues for up to eight devices. Cluster 
servers may service any number of clusters. 



Cluster Server 



Cluster 1 Cluster 2 Cluster n 

I I I 



I I I 

Device 1 Device 2 ... Device 8 

I I I I II 

in out in out in out 

queues queues queues 



Figure IX-1-3. Cluster Server, Clusters and shared queues 



The devices of each cluster must be of the same device class. 

IX-1.5.1 Administrative Interface 

The shared queues I/O mechanism is a data transfer mechanism. Each device class that uses 
this mechanism must also specify an administrative interface. An administrative interface 
contains operations which initialize queues, set device parameters, etc. 

When the I/O messages mechanism is used as an administrative interface, for example, the 
device class specification defines device-specific command codes and reply records and is 
used to initialize the clusters. 

IX-1.5.2 Device Driver Example 

Figures DC- 1-4 and IX-1-5 show how shared queues work with CPs and their relationship with 
an administrative interface. 
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Figure IX-1-4. Device Driver with the Shared Queues Mechanism 



IX-1.5.3 I/O Shared Queues Data Transfer Mechanism 

An input and an output queue are used to support data transfer between a device manager and a 
low-speed device via a CP/device driver. Each queue has a read pointer and a write pointer 
which indicate where the next character will be read or written, flags to indicate queues need- 
ing service and semaphores to block writers when queues are full. The data transfer process 
consists of four distinct activities: 

• Data Transfer From the Device Manager to the Output Queue 

The device manager writes data to the output queue. 

• Data Transfer From the Output Queue to the Device 

The CP/device driver polls its devices' output queues, and transfers any characters to those 
devices. 

• Data Transfer From the Device to the Input Queue 

The device interrupts the CP/device driver when it has characters to be returned to the 
device manager. The CP/device driver transfers the data to the input queue. 

• Data Transfer From the Input Queue to the Device Manager 

The cluster server polls its clusters and calls an input handler for any input queue contain- 
ing characters. 

These activities are described in more detail following Figure IX- 1-5. 
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1 . A device manager transfers characters from an application's buffer to the output shared 
queue associated with the device. 

2. When each write completes, the cluster_ob j ect . new_output_f lags flag cor- 
responding to the output queue associated with the device is set to show that this output 
queue is active (contains characters to be transferred to the device). 

3. If the output queue fills before the device manager completes a write, 
cluster_ob ject . new_input_f lags is still set to active, and the writer blocks on 
device_state_rep . block_user. The device manager sets the boolean 
device_state_rep . writer_blocked to true. 

4. The cluster server periodically checks the state of the output queue, and unblocks the writer 
when the contents of the output queue reach a low enough number of characters that more 
characters can be accepted. 

5. When the number of characters remaining in the output queue is less than a 
low_water_mark (device_state_rep . low__water_mark), the cluster server 
unblocks the writer (calls Semaphore_Mgt . V), sets 
device_state_rep . block_user to false and calls 

device_state_rep . input_handler. This optimization technique prevents exces- 
sive blocking and context switching. 

device_state_rep . output_write_ptr and 

device_state_rep . output_read_ptr are pointers for the output queue that indicate 

where to write and where to begin reading the next character. The device manager writes 
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characters beginning at the location indicated by the write pointer, and increments the pointer 
by the number of characters written. Likewise, the device manager reads characters beginning 
at the location indicated by the read pointer and increments the pointer by the number of 
characters read. 

The queue is empty when the read pointer is equal to the write pointer. The queue is full when 
the read pointer is one more than the write pointer mod the queue size. 

Data Transfer From the Output Queue to the Device 

1. A CP/device driver periodically reads cluster_ob ject . new_output_f lags to 
determine if any of its device's output queues needs to be serviced. 

2. For each active device, it sets the device's output flag in 

cluster_ob ject . new_output_f lags to false and sends a character to the device 
starting an interrupt-driven transfer loop. 

The interrupt-driven loop is initiated by the CP/device driver when it polls the output queue 
and finds the new output flag set The interrupt routine sets the new output flag to false and 
sends a character from the output queue to the device. (The flag must be reset before the 
character is sent.) When the device interrupts the CP/device driver to acknowledge receipt of 
the character, the loop checks the output queue again for another character to be sent This 
loop continues until there are no more characters in the output queue. 

NOTE 

Occasionally, an output queue is marked active for which the interrupt-driven output 
transfer loop is in progress. The CP can detect this situation because it maintains an 
internal flag for each device that indicates whether or not a send is in progress. If a send 
is in progress, the CP marks the queue as inactive and moves on to the next active output 
queue. 

Data Transfer From the Device to the Input Queue 

1. The device sends an interrupt to the CP/device driver when it has a character to send. The 
CP/device driver calls an interrupt handler which places the character in the input queue, 
and sets the new input flag to true. (The character must be sent before the flag is reset.) 

2. If the CP/device driver is unable to put a character in an input queue because the queue is 
full, it discards the character and sets the queue's overflow boolean, input_lost. 

The use of the pointers in the input queue is similar to the use with the output queues except 
that the CP/device driver writes the characters using the write pointer and the device manager 
reads the character using the read pointer. A CP/device driver updates the read pointer of the 
output queue when removing characters. A CP/device driver reads the characters at the read 
pointer and increments the read pointer. 

Data Transfer From the Input Queue to the Device Manager 

1. The cluster server periodically checks the new input flags. If an input flag is set, the cluster 
server calls the input handler for the device (device_state_rep . input_handler). 
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IX-1 .6 Summary 

• A device object is a typed object that represents a device. 

• A device manager is a type manager that controls access to a device. 

• An opened device object is a typed object that represents an input/output connection be- 
tween a device manager and a device. 

• A device class is a specification that defines the device-specific details necessary to access 
a member of a class of devices using an I/O mechanism. 

• An access method is a collection of procedures that provide a device-independent interface 
to perform I/O. 

• The I/O messages data transfer mechanism supports high-speed, block-oriented data trans- 
fer. 

• The shared queues data transfer mechanism supports low-speed, character-oriented data 
transfer. 

• An I/O message is an object consisting of four parts: common part, device driver part, 
device manager part and buffer description part 

• A recovery agent detects I/O processor failures and maintains a table of existing I/O mes- 
sages. 
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The appendixes are: 

Ada Examples Contains complete listings of all examples used in this guide. 
Glossary Defines terms used in this guide. 
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DBMS_Support_Ex Package Body X-A-38 

Employee_Filing_Ex Package Specification X-A-42 

Employee_Filing_Ex Package Body X-A-46 

Hello_ada_ex Procedure X-A-54 

Hello_OS_ex Procedure X-A-55 

Join_File_Ex Package Specification .X-A-56 

Join_File_Ex Package Body X-A-57 

Record_Locking_Ex Package Specification X-A-61 

Record_Locking_Ex Package Body X-A-62 

Output_bytes_ex Procedure X-A-64 

Output_records_ex Procedure X-A-65 

Print_cmd_ex Procedure X-A-67 

Print_Cmd_Mes sages Package X-A-70 

Record_AM_Ex Package Specification X-A-71 

Record_AM_Ex Package Body X-A-75 

Simple_editor_cmd__ex Procedure X-A-84 

Simple_Editor_Ex Package Specification X-A-85 

Simple_Editor_Ex Package Body X-A-89 

Human Interface Services X-A-104 

Inventory_main Procedure X-A-105 

Invent or y_Files Package Specification X-A-108 

Invent or y_Files Package Body X-A-115 

Inventory_Forms Package Specification X-A-121 

Inventory_Forms Package Body X-A-126 

Inventory_Menus Package Specification X-A-137 

Inventory_Menus Package Body X-A-140 
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Inventory_Reports Package Specification X-A-144 

Inventory_Reports Package Body X-A-146 

Inventory_Windows Package Specification X-A-152 

Inventory_Windows Package Body X-A-154 

Invent ory__Mes sages Package Specification X-A-156 

Program Services X-A-156 

At_cmd_ex Procedure X-A-157 

At_Support_Ex Package Specification X-A-160 

At_Support_Ex Package Body X-A-162 

Compiler_Ex Package Specification X-A-168 

Compiler_Ex Package Body X-A-169 

Conversion_Support_Ex Package Specification X-A-172 

Memory_ex Procedure X-A-176 

Process_Globals_Support_Ex Package Specification X-A-177 

Process_Globals_Support JEx Package Body X-A-182 

Stream_f ile_ex Procedure X-A-103 

Symbol_Table_Ex Package Specification X-A-191 

Symbol_Table_Ex Package Body X-A-193 

Word_Processor_Ex Package Specification X-A-197 

Word__Processor_Ex Package Body X-A-198 

View_device_main Procedure X-A-203 

VD_Def s Package Specification X-A-206 

VD_Commands Package Specification X-A-208 

VD_Commands Package Body X-A-209 

VD_Devices Package Specification X-A-213 

VD_Devices Package Body X-A-215 

Type Manager Services X-A-218 

Acct_main_ex Procedure X-A-219 

Acct_visual Package Specification X-A-236 

Acct_Visual Package Body X-A-238 

Account Manager Command File X-A-244 

Account JTypes_Ex Package Specification X-A-250 

Account_Mgt_Ex Package Specification X-A-251 

Account_Mgt_Ex (Active Only) Package Body X-A-256 

Account_Mgt_Ex (Stored, Non-transaction-oriented) Package Body X-A-261 

Account_Mgt_Ex (Stored, Transaction-oriented) Package Body X-A-267 

Stored_Account_TDO_Init_Ex Procedure X-A-276 

Account_Type_Name_Ex Package Specification X-A-279 

Account_Type_Name_Ex Package Body X-A-280 

Type_Name_Attr_Ex Package Specification X-A-281 

Type_Name_Attr_Ex Package Body X-A-282 

Type_Name_Attribute_Init_Ex Procedure X-A-283 

Ref use_Reset_Active_Version_Ex Package Specification X-A-284 

Ref use_Reset_Active_Version_Ex Package Body X-A-285 

Account_Mgt_Ex (Distributed) Package Body X-A-286 

Distr_Acct_Call_Stub_Ex Package Specification X-A-298 

Distr__Acct_Call_Stub_Ex Package Body X-A-300 

Distr_Acct_Server_Stub_Ex Package Specification X-A-304 

Distr_Acct_Server_Stub_Ex Package Body X-A-306 

Distr_Acct_Init Procedure X-A-308 

Distr_Acct_Home_Job_Ex Procedure X-A-312 

Makefile X-A-313 



Named_copy_ex Procedure X-A-315 

Older than ex Function X-A-317 
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X-A.1 Introduction 



This appendix contains full listings of all the examples in the BUN I OS Guide grouped by 
service area. ( 

All examples were compiled using Version VI. 00.02 of the BiiN™ Ada compiler, and all 
compiled successfully (except where noted). Most examples are not yet tested, however. 
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X-A-4 Ada Examples 



X-A.2.1 ExampiejMessages Package Specification 



1 with Incident_Defs, 

2 System, 

3 System_Defs; 
4 

5 package Example_Messages is 
6 

7 — Function: 

8 — Define messages used by example programs. 
9 

10 — A single message file is used. All messages 

11 — defined use a module ID of 0. 
12 

13 msg_file_pathname: constant System_Defs.text_AD := 

14 new System_Defs.text' ( 

15 30, 30, "/examples/msg/example_messages") ; 

16 — AD to pathname of message file, bound to 

17 — n msg_obj", following. 
18 

19 — *This will go away when "pragma bind" changes.* 
20 

21 msg_obj: constant System. untyped_word := 

22 System. null_word; 

23 pragma bind(msg_obj, 

24 "example_messages.msg_file_pathname") ; 

25 — Message object for incident codes in 

26 — example programs, bound to above "message_file_pathname", 
27 

28 — *When the resident compiler and linker are* 

29 — *ready, this pragma will become:* 

30 — | pragma bind(msg_obj, 

31 — | "/examples/msg/example_messages") ; 
32 

33 

34 not_directory_code: 

35 constant Incident_Defs.incident_code := 

36 (0, 1, Incident_Defs. error, msg_obj); 
37 

38 — *M* store :module=0 :number=l \ 

39 — *M* :msg_name=not_di rectory _code \ 

40 — *m* : short = \ 

41 — *M* "$pl<pathname> is not a directory." 
42 

43 not_exist_or_no_access_code: 

44 constant Incident_Defs.incident_code := 

45 (0, 2, Incident_Defs. error, msg_obj); 
46 

47 — *M* store :module=0 :number=2 \ 

48 — *M* :msg_name=not_exist_or_no_access_code \ 

49 __* M * : short = \ 

50 — *M* "$pl<pathname> does not exist or does\ 

51 — *M* not allow you access." 
52 

53 no_access_code: 

54 constant Incident_Defs.incident_code := 

55 (0, 3, Incident_Defs. error, msg_obj); 
56 

57 — *M* store :module=0 :number=3 \ 

58 — *M* :msg_name=no_access_code \ 

59 __*m* : short = \ 

60 — *M* "$pl<pathname> does not allow\ 

61 — *M* you access." 
62 

63 overwrite_query_code: 

64 constant Incident_Defs.incident_code := 

65 (0, 4, Incident_Defs. information, msg_obj); 
66 

67 — *M* store :module=0 :number=4 \ 

68 — *M* :msg_name=overwrite_query_code \ 

69 — *m* : short - \ 

70 — *M* "$pl<pathname> exists. Overwrite it?" 

71 not_overwritten_code: 

72 constant Incident_Defs.incident_code := 

73 (0, 5, Incident_Defs. error, msg_obj); 
74 
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75 — *M* store :module=0 :number=5 \ 

76 — *M* :msg_name=not_overwritten_code \ 

77 __*m* : short - \ 

78 — *M* n $pl<pathname> not overwritten." 
79 

80 create_name_space_aborted_code : 

81 constant Incident_Defs.incident_code := 

82 (0, 6, Incident_Defs. information, msg_obj) 
83 

84 — *M* store :module=0 :number=6 \ 

85 — *M* :msg_name= \ 

86 — *M* create_name_space_aborted_code \ 

87 — *M* : short = "Operation aborted. \ 

88 — *M* No name space was created." 
89 

90 name_space_created_code: 

91 constant Incident_Defs.incident_code := 

92 (0, 7, Incident_Defs. information, msg_obj) 
93 

94 — *M* store :module=0 :number=7 \ 

95 — — *M* ;msg name— name space created code \ 

96 — *m* : short = \ 

97 — *M* "Name space $pl<pathname> created." 
98 

99 end Example_Messages; 
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X-A.2.2 Long_integer_Ex Package Specification 



1 with Long_Integer_Defs; 

2 

3 package Long_Integer_Ex is 

4 

5 — Function: 

6 — Provide examples of using long integers. 

7 — See the package body for detailed comments. 
8 

9 

10 function Long_integer_value ( 

11 image: string) 

12 return Long_Integer_Defs.long_integer; 
13 

14 

15 function Get_long_integer 

16 return Long_Integer_Defs.long_integer; 
17 

18 

19 function Multiply_divide ( 

20 a: integer; 

21 b: integer; 

22 c: integer) 

23 return integer; 
24 

25 

26 procedure Use_it; 

27 

28 

29 pragma external; 

30 

31 end Long Integer Ex; 
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X-A.2.3 Long_integer_Ex Package Body 



i 

2 

3 
4 
5 
6 
7 
8 
9 
10 
11 
12 
13 
14 
15 
16 
17 
18 
19 
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21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
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with Byte_Stream_AM, 
Device_Defs, 
Long_Integer_Defs, 
Process_Mgt, 
P roce s s_Mgt_Type s , 
System, 
System_Exceptions; 

package body Long_Integer_Ex is 

— Function: 

— Provide examples of using long integers. 

— • History: 

12-02-87 Martin L. Buchanan Initial version. 



function Long_integer_value ( 
image: string) 
return Long_Integer_Def s . long_integer 

— Function: 

Converts a string image to a long integer. 

The image must have the following syntax: 



image ::= {space} [sign] digit { [_] digit } 

{ space } 
space : : = ' ' 
sign : := + I - 
digit ::= 0|1|2|3|4|5|6|7|8|9 



After leading and trailing spaces are stripped 
off, the remaining part of the image cannot 
be longer than 31 characters. 

— Notes: 

Unlike "Long_Integer_Def s.Long_integer_value", 
this function handles strings of varying length 
and strings that contain trailing spaces. 

— Exceptions: 

System_Exceptions.bad_parameter - 

"image" has incorrect syntax, contains a 
number longer than 31 characters, or contains 

— a number that cannot be represented as a long 
integer. 

is 

li_string: Long_Integer_Def s. string_integer; 

— Fixed-length string required by 

— "Long_Integer_Def s. long_integer_value" 

— when converting to a long integer, 
i : integer; 

— Will be index of right-most non-space character 

— in "image", 
j : integer; 

— Will be index of left -most non-space character 

— in "image". 
k: integer; 

— Will be index of left -most character in 

— "li_string" that is copied from "image (j . .i) ". 
li : Long_Integer_Def s. long_integer; 

— The resulting long integer to return, 
begin 

— Make "i" the index of the right -most 

— non-space character in "image": 

i := image' last; 
loop 

if i < image' first then 

— "image" contains all spaces, or is a 

— null string: 
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75 RAISE System_Exceptions.bad_parameter; 
76 

77 else 

78 EXIT when image (i) /= ' '; 

79 i := i - 1; 

80 end if; 

81 end loop; 
82 

83 — Make "j" the index of the left-most 

84 — non-space character in "image". No check 

85 — is needed for "image" being null or all 

86 — spaces, as those conditions are checked 

87 — above. 
88 

89 j := image' first; 

90 loop 

91 exit when image (j) /= ' '; 

92 j :- j + 1; 

93 end loop; 
94 

95 if (i - j + 1) > li_string' length then 
96 

97 — The number is longer than 31 characters 

98 — after stripping off spaces: 
99 

100 RAISE System_Exceptions.bad_parameter; 

101 

102 else 

103 

104 — -k" is the index within "li_string" of the 

105 — leftmost character copied from "image". "k" is 

106 — computed to satisfy the following predicate: 

107 — | i - j - li_string'last - k 

108 — This predicate simply specifies that the number 

109 — of source characters copied equals the number 

110 — of destination characters. 
Ill 

112 k := li_string'last + j - i; 
113 

114 — Copy the significant characters from "image" to 

115 — be right- justified within "li_string": 
116 

117 li_string(k .. li_string' last) := 

118 image (j .. i) ; 
119 

120 — Fill any remaining left-hand characters in 

121 — "li_string" with spaces: 
122 

123 for m in li_string' first . . k-1 loop 

124 li_string(m) := ' '; 

125 end loop; 
126 

127 — Compute and return the long integer value: 

128 

12 9 Long_Integer_Def s . Long_integer_value ( 

130 image => li_string, 

131 number => li); — out. 

132 RETURN li; 
133 

134 end if; 

135 end Long_integer_value; 
136 

137 

138 function Get_long_integer 

139 return Long_Integer_Defs.long_integer 
140 

141 — Function: 

142 — Gets a long integer on a single line 

143 — from the calling process's standard input. 
144 

145 — Notes: 

146 — See "Long_integer_value" in this package 

147 — for a description of the required long 

148 — integer syntax and of what happens if 

149 — the syntax is violated. 
150 

151 — There is no check for a line that's too long. 
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152 is 

153 LINE_SIZE: constant integer : = 80; 

154 — A line read from the standard input must 

155 — be <=* 80 characters. 

156 line: stringd .. LINE_SIZE) ; 

157 — Line buffer. 

158 length: integer; 

159 — Number of characters actually read. 

160 begin 

161 • — Read the line: 
162 

163 length := integer (Byte_Stream_AM. Ops. Read { 

1 64 Device_Def s . opened_device ( 

165 Process_Mgt .Get_process_globals_entry ( 

166 Process_Mgt_Types . standard_input ) ) , 

167 line' address, 

1 68 System. ordinal (LINE_SIZE) ) ) ; 
169 

170 — Strip any linefeed at the end: 
171 

172 if line (length) = ASCII. LF then 

173 length := length - 1; 

174 end if; 
175 

176 — Convert to a long integer and return: 
177 

178 return Long_integer_value (lined, .length) ) ; 

179 end Get_long_integer; 
180 

181 

182 function Multiply_divide ( 

183 a: integer; 

184 b: integer; 

185 c: integer) 

186 return integer 

187 ~ (a * b) / c 
188 

189 — Function: 

190 — Computes and returns the product of two 

191 — integers divided by a third integer, using 

192 — a long integer for the intermediate result 

193 — to avoid overflow. 
194 

195 — This function is useful for scaling and 

196 — unit conversions, to avoid overflow within 

197 — the calculation when the result after the 

198 — division step can still be represented as 

199 — an integer. 
200 

201 — Exceptions: 

202 — System_Exceptions.bad_parameter - 

203 — Overflow or division by zero. 

204 is 

205 — Convert all parameters to long integers: 
206 

207 a_long: Long_Integer_Defs.long_integer := 

208 Long_Integer_Def s.Convert_to_long_integer (a) ; 

209 b_long: Long_Integer_Defs.long_integer := 

210 Long_Integer_Defs.Convert_to_long_integer (b) ; 

211 c_long: Long_Integer_Defs.long_integer := 

212 Long_Integer_Defs.Convert_to_long_integer (c) ; 
213 

214 — Import long integer operators: 

215 

216 use Long_Integer_Defs; 

217 

218 begin 

219 return Convert_to_integer ( (a_long * b_long) / c_long ) 

220 end Multiply_divide; 
221 

222 

223 procedure Use_it 

224 

225 — Function: 

226 — Show some computations with long integers. 
227 

228 — Notes: 
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229 — This procedure is not yet testable as it 

230 — is not a command and its variables are not 

231 — yet displayed. 

232 is 

233 — Import long integer operators and the 

234 — n long_integer n type: 
235 

236 use Long_Integer_Defs; 

237 

238 — Some variables to play with: 

239 

240 a: long_integer; 

241 b: long_integer; 

242 i: integer; 
243 

244 — Declaring a negative long integer constant, 

245 — the easy way and the hard way: 
246 

247 negative_twenty: constant long_integer : = 

248 - long_integer' (0, 20); 
249 

250 another_negative_twenty: constant long_integer := 

251 (16#ffff_ffff#, 16#ffff_ffec#); 

252 — Use the hard way when you want a declaration 

253 — elaborated at compile-time instead of 

254 — at run-time. 

255 begin 

256 — Add one to a long integer: 
257 

258 a := a + Long_Integer_Defs.one; 

259 

260 — Add a positive integer "i" to a long integer: 

261 

262 b := b + long_integer' (0, System. ordinal (i) ) ; 

263 end Use_it; 
264 

265 

266 end Long Integer Ex; 
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X-A.2.4 Make_menu_groupJDDef_ex Procedure 



1 
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with Data_Definition_Mgt, 
Di rect ory_Mgt , 
Passive_Store_Mgt, 
System, 
System_Defs, 
Text_Mgt; 

procedure Make_menu_group_DDef_ex 

— Function: 

Creates and stores a menu group DDef, 

— containing two menus and five menu items: 



Menu 1 



Menu 2 



Menu Item 1 
Menu Item 2 



Menu Item 1 
Menu Item 2 
Menu Item 3 



is 



use Data_Definition_Mgt; — to import enumeration types 

ddf: Data_Definition_Mgt.DDef_AD; 

untyped_ddf : System. untyped_word; 
FOR untyped ddf USE AT ddf address; 



group_node : 
menu_l i st_node : 
menu_node : 
item_list_node: 
item_node: 
dont_care_node : 
name: 
prop_value : 

begin 



Data_Def inition_Mgt . node_ref erence; 
Data_Definition_Mgt .node__reference; 
Data_Definition_Mgt.node_ref erence; 
Data_Def inition_Mgt . node_ref erence; 
Data_Definition_Mgt.node_ref erence; 
Data_Definition_Mgt.node_ref erence; 
System_Defs. text (100) ; 
Data Definition Mgt. property value (100) 



ddf := Data_Definition_Mgt.Create_DDef; 

— Create menu group 

Text_Mgt . Set (name, "group_node") ; 

group_node := Data_Definition_Mgt.Create_node ( 

DDef =»> ddf, 

node_name -> name, 

root => private_root_node) ; 

prop_value . simple_pv := (pv_boolean, true); 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => group_node, 

property => pi_derive_all, 

value => prop_value) ; 

prop_value.simple_pv := (pv_boolean, true); 
Data_Def inition_Mgt . Add_jproperty_value ( 

node_ref => group_node, 

property => pi_import, 

value => prop_value) ; 

prop_value . simple_pv := (pv_type => pv_string) ; 
Text_Mgt . Set (prop_value . text_value , "menu_group_t " ) ; 
Data_Def inition_Mgt . Add_property_value ( 

node_ref -> group_node, 

property => pi_DDef_name, 

value => prop_value) ; 

Text_Mgt . Set (prop_value.text_value, "/ddef s/menu_DDef ") 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => group_node, 

property => pi_DDef_name, 
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value => prop_value) ; 

Text_Mgt . Set (name, "menu_list ") ; 

menu_list_node := Data_Definition_Mgt.Create_field( 

record_node => group_node, 

node_name => name, 

property => pi_has_value, 

value => (pv_node_reference, menu_node) ) ; 



— Create the first menu ("Menu 1") : 

Text_Mgt . Set (name , "menu_node " ) ; 

menu_node := Data_Definition_Mgt.Create_node ( 

DDef => ddf, 

node_name => name, 

root => private_root_node) ; 

prop_value.simple_pv := (pv_boolean, true); 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => menu_node, 

property => pi_derive_all, 

value => prop_value) ; 

prop_value. simple _jpv := (pv_boolean, true); 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => menu_node, 

property => pi_import, 

value => prop_value) ; 

prop_value . simple_pv := (pv_type => pv_string) ; 
Text_Mgt.Set (prop_value.text_value, "menu_t") ; 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => menu_node, 

property => pi_DDef_name, 

value => prop_value) ; 

Text_Mgt.Set (prop_value.text_value, "/ddefs/menu_DDef **) 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => menu_node, 

property => pi_DDef_name, 

value => prop_value) ; 

Text_Mgt . Set (name, "menu_id" ) ; 

dont_care_node := Data_Definition_Mgt .Create_field( 

record_node => menu_node, 

node_name => name, 

property => pi_has_value, 

value => (pv_int4, 1)); 

prop_value.simple_pv := (pv_type => pv_string) ; 
Text_Mgt . Set (prop_value . text_value , "Menu 1 " ) ; 
Text_Mgt . Set (name, "menu_title") ; 
dont_care_node := Data_Definition_Mgt.Create_field( 

record_node => menu_node, 

node_name => name, 

property => pi_has_value, 

value => prop_value.simple_pv) ; 

Text_Mgt . Set (name, "iten^list") ; 

item_list_node := Data_Definition_Mgt .Create_field( 

record_node => menu_node, 

node name => name) ; 



— Now create the menu items for menu 1 : 



— Create menu item 1: 

Text_Mgt . Set (name, "item_node" ) ; 

item_node := Data_Definition_Mgt.Create_node ( 

DDef => ddf, 

node_name => name, 

root => private_root_node) ; 

prop_value.simple_pv := (pv_boolean, true); 
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152 Data_Definition_Mgt .Add_property_value ( 

153 node_ref => item_node, 

154 property => pi_derive_all, 

155 value «> prop_value) ; 
156 

157 prop_value . simple_pv := (pv_boolean, true); 

158 Data_Definition_Mgt.Add_property_value ( 

159 node_ref => item_node, 

160 property => pi_import, 

161 value => prop_value) ; 
162 

163 prop_value . simple_pv ;= (pv_type => pv_string) ; 

164 Text_Mgt .Set (prop_value.text_value, "menu_item_t") ; 

165 Data_Definition_Mgt.Add__property_value ( 

166 node_ref => item_node, 

167 property => pi_DDef_name, 

168 value => prop_value) ; 
169 

170 Text_Mgt.Set (prop_value.text_value, "/ddefs/menu_DDef ") 

171 Data_Definition_Mgt .Add_property_value ( 

172 node_ref => item_node, 

173 property => pi_DDef_name, 

174 value => prop_value); 
175 

176 Text_Mgt. Set (name, "itemed"); 

177 dont_care_node := Data_Definition_Mgt.Create_field( 

178 record_node => item_node, 

179 node_name => name, 

180 property «■> pi_has_value, 

181 value »> (pv_int4, 1)); 
182 

183 Text_Mgt. Set (name, "checked"); 

184 dont_care_node := Data_Definition_Mgt.Create_field( 

185 record_node => item_node, 

186 node_name => name, 

187 property => pi_has_value, 

188 value => (pv_boolean, true) ) ; 
189 

190 Text_Mgt. Set (name, "enabled"); 

191 dont_care_node := Data_Definition_Mgt.Create_field( 

192 record_node => item_node, 

193 node_name => name, 

194 property => pi_has_value, 

195 value => (pv_boolean, true)); 
196 

197 prop_value . simple_pv := (pv_type => pv_string) ; 

198 Text_Mgt.Set (prop_value.text_value, "Menu Item 1"); 

199 Text_Mgt. Set (name, "text"); 

200 dont_care_node := Data_Definition_Mgt.Create_field( 

201 record_node => item_node, 

202 node_name => name, 

203 property => pi_has_value, 

204 value => prop_value.simple_pv) ; 
205 

206 — Add menu item 1 to menu 1: 
207 

208 prop_value.simple_pv := (pv_node_reference, item_node) ; 

209 Data_Definition_Mgt .Add_property_value ( 

210 node_ref => item_list_node, 

211 property => pi_has_value, 

212 value => prop_value) ; 
213 

214 

215 — Create menu item 2 for menu 1: 

216 

217 Text_Mgt. Set (name, "item_node") ; 

218 item_node := Data_Definition_Mgt .Create_node ( 

219 DDef => ddf, 

220 node_name => name, 

221 root => private_root_node) ; 
222 

223 prop_value . simple_pv := (pv_boolean, true) ; 

224 Data_Def inition_Mgt . Add_property_value ( 

225 node_ref => item_node, 

226 property => pi_derive_all, 

227 value => prop_value) ; 
228 
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prop_value.simple_pv := (pv_boolean, true); 
Data_Def inition_Mgt . Add_property_value ( 

node__ref => item_node, 

property => pi_import, 

value => prop_value) ; 

prop_value.simple_pv := (pv_type => pv_string) ; 
Text_Mgt.Set (prop_value.text_value, "menu_item_t") ; 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => item_node, 

property => pi_DDef_name, 

value => prop_value) ; 

Text_Mgt . Set (prop_value . text_value f "/ddef s/menu_DDef " ) ; 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => item_node, 

property => pi_DDef_name, 

value => prop_value) ; 

Text_Mgt . Set (name, "item_id") ; 

dont_care_node := Data_Definition_Mgt.Create_field( 

record_node => item_node, 

node_name => name, 

property => pi_has_value, 

value => (pv_int4, 2)); 

Text_Mgt . Set (name, "checked") ; 

dont_care_node := Data_Definition_Mgt.Create_field( 

record_node => item_node, 

node_name => name, 

property => pi_has_value, 

value => (pv_boolean, false)); 

Text_Mgt . Set (name, "enabled" ) ; 

dont_care_node := Data_Definition_Mgt.Create_field( 

record_node => item_node, 

node_name => name, 

property => pi_has_value, 

value => (pv_boolean, false) ) ; 

prop_value.simple_pv := (pv_type => pv_string) ; 
Text_Mgt.Set (prop_value.text_value, "Menu Item 2"); 
Text_Mgt. Set (name, "text"); 
dont_care_node := Data_Definition_Mgt.Create_field( 

record_node => item_node, 

node_name => name, 

property => pi_has_value, 

value => prop_value.simple_pv) ; 



— Add menu item 2 to menu 1: 

prop_value. simple_pv := (pv_node_reference, item_node) ; 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => item_list_node, 

property => pi_has_value, 

value => prop value) ; 



— Add menu 1 to the menu group: 

prop_value.simple_pv := (pv_node_reference, menu_node) 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => menu_list_node, 

property => pi_has_value, 

value => prop_value) ; 

— Create menu 2: 

Text_Mgt . Set (name, "menu_node" ) ; 

menu_node := Data_Definition_Mgt.Create_node ( 

DDef => ddf, 

node_name => name, 

root => private_root_node) ; 

prop_value . simplejpv := (pv_boolean, true); 
Data_Def inition_Mgt . Add_property_value ( 
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306 node_ref »> menu_node, 

307 property ■»> pi_derive_all, 

308 value => prop_value); 
309 

310 prop_value . simple_pv := (pv_boolean, true); 

311 Data_Def inition_Mgt . Add_property_value ( 

312 node_ref => menu_node, 

313 property => pi_import, 

314 value => prop_value) ; 
315 

316 prop_value . simple_pv := (pv_type => pv_string) ; 

317 Text_Mgt . Set (prop_value . text_value , "menu_t " ) ; 

318 Data_Definition_Mgt .Add_joroperty_value ( 

319 node_ref => menu_node, 

320 property => pi_DDef_name, 

321 value => prop_value) ; 
322 

323 Text_Mgt.Set (prop_value.text_value, "/ddefs/menu_DDef ") 

324 Data_Definition_Mgt .Add_jproperty_value ( 

325 node_ref => menu_node, 

326 property => pi_DDef_name, 

327 value => prop_value) ; 
328 

329 Text_Mgt. Set (name, "menu_id") ; 

330 dont_care_node := Data_Definition_Mgt .Create_field( 

331 record_node => menu_node, 

332 node_name => name, 

333 property => pi_has_value, 

334 value => (pv_int4, 2)); 
335 

336 prop_value.simple_pv := (pv_type => pv_string) ; 

337 Text_Mgt.Set (prop_value.text_value, "Menu 2"); 

338 Text_Mgt. Set (name, ,, menu_title") ; 

339 dont_care_node := Data_Definition_Mgt.Create_field( 

340 record_node => menu_node, 

341 node_name => name, 

342 property => pi_has_value, 

343 value => prop_value.simple_pv) ; 
344 

345 Text_Mgt. Set (name, "itemj.ist") ; 

346 item_list_node := Data_Definition_Mgt .Create_field( 

347 record_node => menu_node, 

348 node_name => name) ; 
349 

350 ~ Now create menu items for menu 2: 

351 

352 — Create menu item 1 for menu 2: 

353 

354 Text_Mgt. Set (name, "item_node") ; 

355 item_node := Data_Definition_Mgt.Create_node ( 

356 DDef => ddf, 

357 node_name => name, 

358 root => private_root_node) ; 
359 

360 prop_value . simple_pv := (pv_boolean, true) ; 

361 Data_Def inition_Mgt .Add_property_value ( 

362 node_ref => item_node, 

363 property => pi_derive_all, 

364 value => prop_value) ; 
365 

366 prop_value.simple_pv := (pv_boolean, true); 

367 Data_Definition_Mgt .Add_property_value ( 

368 node_ref => item_node, 

369 property => pi_import, 

370 value => prop_value) ; 
371 

372 prop_value . simple_pv := (pv_type => pv_string) ; 

373 Text_Mgt.Set (prop_value.text_value, "menu_item_t") ; 

374 Data_Definition_Mgt.Add_property_value ( 

375 node_ref => item_node, 

376 property => pi_DDef_name, 

377 value => prop_value) ; 
378 

379 Text_Mgt .Set (prop_value.text_value f "/ddefs/menuJDDef") 

380 Data_Definition_Mgt.Add_property_value ( 

381 node_ref -> item_node, 

382 property => pi_DDef_name, 
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value 



=> prop value) ; 



Text_Mgt . Set {name, "item_id" ) ; 



dont_care_node 
record_node 
node_name 
property 
value 



Data_Def inition_Mgt .Create_f ield ( 
=> item_node, 
=> name , 

=> pi_has_value, 
=> (pv int4, 1)); 



Text_Mgt . Set (name, "checked" ) ; 

dont_care_node := Data_Definition_Mgt .Create_field( 

record_node => item_node, 

node_name => name, 

property => pi_has_value, 

value => (pv_boolean, true)); 

Text_Mgt . Set (name, "enabled") ; 

dont_care_node := Data_Definition_Mgt .Create_field( 

record_node => item_node, 

node_name => name, 

property => pi_has_value, 

value =>> (pv_boolean, true) ) ; 

prop_value . simple^ pv := (pv_type => pv_string) ; 
Text_Mgt-Set (prop_value.text_value, "Menu Item 1"); 
Text_Mgt . Set (name, "text " ) ; 
dont_care_node := Data_Definition_Mgt .Create_fleld( 

record_node => item_node, 

node_name => name, 

property => pi_has_value, 

value => prop_value.simple_pv) ; 



— Add menu item 1 to menu 2: 

prop_value.simple_pv := (pv_node_reference, item_node) 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => item_list_node, 

property => pi_has_value, 

value => prop value) ; 



— Create menu item 2 for menu 2: 

Text_Mgt .Set (name , "it em_node " ) ; 

item_node := Data_Definition_Mgt .Create_node ( 

DDef => ddf, 

node_name => name, 

root => private_root_node) ; 

prop_value . simple_pv := (pv_boolean, true); 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => item_node, 

property => pi_derive_all, 

value => prop_value) ; 

prop_value.simple_pv := (pv_boolean, true); 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => item_node, 

property => pi_import, 

value => prop_value) ; 

prop_value.simple_pv := (pv_type => pv_string) ; 
Text_Mgt.Set (prop_value.text_value, "menu_item_t") ; 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => item_node, 

property => pi_DDef_name, 

value => prop_value) ; 

Text_Mgt.Set (prop_value. text_value, "/ddefs/menu_DDef") 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => item_node, 

property => pi_DDef_name, 

value => prop_value) ; 

Text_Mgt . Set (name, "item_id" ) ; 

dont_care_node := Data_Definition_Mgt .Create_field( 
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record_node => item_node, 
node_name => name, 
property => pi_has_value, 
value => (pv_int4, 2) ) ; 

Text_Mgt . Set ( name , " checked" ) ; 

dont_care_node := Data_Definition_Mgt.Create_field( 

record_node => item_node, 

node_name -> name, 

property => pi_has_value, 

value => (pv_boolean, true) ) ; 

Text_Mgt . Set (name, "enabled" ) ; 

dont_care_node := Data_Definition_Mgt.Create_field( 

record_node => item_node, 

node_name => name, 

property => pi_has_value, 

value => (pv_boolean, true) ) ; 

prop_value . simple_pv := (pv_type »> pv_string) ; 
Text_Mgt.Set (prop_value.text_value, "Menu Item 2"); 
Text_Mgt . Set (name, "text") ; 
dont_care_node := Data_Definition_Mgt.Create_field( 

record_node => item_node, 

node_name => name, 

property => pi_has_value, 

value => prop_value.simple_pv) ; 



— Add menu item 2 to menu 2: 

prop_value.simple_pv := (pv_node_reference, item_node) 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => item_list_node, 

property => pi_has_value, 

value => prop_value) ; 



— Create menu item 3 for menu 2: 

Text_Mgt . Set (name, "item_node") ; 

item_node := Data_Definition_Mgt .Create_node ( 

DDef => ddf, 

node_name => name, 

root => private_root_node) ; 

prop_value.simple_pv := (pv_boolean, true); 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => item_node, 

property => pi_derive_all, 

value => prop_value) ; 

prop_value . simple^pv := (pv_boolean, true); 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => item_node, 

property => pi_import, 

value => prop_value) ; 

prop_value . simple_jpv := (pv_type => pv_string) ; 
Text_Mgt . Set (prop_value . text_value, "menu_item_t " ) ; 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => item_node, 

property => pi_DDef_name, 

value =o> prop_value) ; 

Text_Mgt . Set (prop_value . text_value, "/ddef s/menu_DDef " ) 
Data_Def inition_Mgt . Add_property_value ( 

node_ref => item_node, 

property => pi_DDef_name, 

value => prop_value) ; 

Text_Mgt . Set (name, "item_id") ; 

dont_care_node := Data_Definition_Mgt.Create_field( 

record_node => item_node, 

node_name => name, 

property => pi_has_value, 

value => (pv int4, 3)); 
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537 

538 Text_Mgt. Set (name, "checked"); 

539 dont_care_node := Data_Definitiori_Mgt.Create_field( 

540 record_node ~> item_node, 

541 node_name => name, 

542 property => pi_has_value, 

543 value => (pv_boolean, true)); 
544 

545 Text_Mgt. Set (name, "enabled"); 

546 dont_care_node := Data_Definition_Mgt.Create_field( 

547 record_node => item_node, 

548 node_name => name, 

549 property => pi_has_value, 

550 value => (pv_boolean, false)); 
551 

552 prop_value.simple_pv := (pv_type => pv_string) ; 

553 Text_Mgt.Set (prop_value.text_value, "Menu Item 3"); 

554 Text_Mgt. Set (name, "text"); 

555 dont_care_node := Data_Definition_Mgt.Create_field( 

556 record_node => item_node, 

557 node_name => name, 

558 property => pi_has_value, 

559 value => prop_value.simple_pv) ; 
560 

561 

562 — Add menu item 3 to menu 2: 

563 

564 prop^alue.simple^pv := (pv_node_reference, item_node) 

565 Data_Definition_Mgt.Add_property_value ( 

566 node_ref => item_list_node, 

567 property => pi_has_value, 

568 value => prop_value) ; 
569 

570 

571 — Add menu 2 to the menu group: 

572 

573 prop_value . simple_pv := (pv_node_reference, menu_node) 

574 Data_Definition_Mgt .Add_property_value ( 

575 node_ref => menu_list_node, 
property => pi_has_yalue, 
value => prop_value) ; 



576 
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583 



— Complete and close the menu group: 

prop_value.simple_pv := (pv_type => pv_string) ; 

obj Text_Mgt.Set (prop_value.text_value, "/tdo/menu_group_tdo") 

584 Data_Def inition_Mgt . Add_property_value ( 

585 node_ref => group_node, 

586 property => pi_kind, 

587 value => prop_value) ; 
588 

589 

590 — Close the definition (DDef) : 

591 

592 Data_Def inition_Mgt. Close ( 

593 DDef => ddf ) ; 
594 

595 

596 — Store the DDef: 

597 

598 Text_Mgt. Set (name, "///pathname/menu_group_DDef") ; 

599 Directory_Mgt. Store (name, untyped_ddf ) ; 
600 

601 — Request update of stored DDef: 
602 

603 Passive_Store_Mgt.Request_update ( 

604 obj => untyped_ddf ) ; 
605 

606 end Make menu group DDef ex; 
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X-A.2.5 Manage_application_environmeivt__ex Procedure 

1 with CLJDefs, 

2 Environment_Mgt f 

3 String_List_Mgt, 

4 System, 

5 System_Defs, 

6 Text_IO, 

7 Text_Mgt; 
8 

9 procedure Manage_Application_Environment_Ex 
10 

11 — Function: 

12 — Example program showing use of environment 

13 — variables. 
14 

15 — History: 

16 — 06-26-87, William Anton Rohm: Written. 

17 — 12-02-87, WAR: Revised. 
18 

19 is 

20 

21 package Int_IO is new Text_IO. Integer_IO (integer) ; 

22 

23 — Variables: 

24 

25 variable_name: System_Defs.text ( 

2 6 CL_Def s . max_name_sz ) ; 

27 variable_type: CL_Defs.var_type; 

28 variable_mode: CL_Defs.var_mode; 
29 

30 variable_name_list : System_Defs.string_list (1000) ; 
31 

32 integer_value: integer; 

33 ASCII_value: System_Def s. text (1000) ; 

34 answer: character; 
35 

36 use CL_Defs; — to import "=" for CL_Defs.var_mode 

37 use System; — to import "+" for System. ordinal 
38 

39 begin 
40 

41 — Create a new local integer variable named 

42 ■ — "new_integer" : 
43 

44 Text_Mgt . Set { 

45 dest => variable_name, 

46 source => "new_integer") ; 
47 

48 Environment_Mgt . Set_integer ( 

49 var_name => variable_name, 

50 value => 0, 

51 mode => CL_Def s. read_write, 

52 global => false) ; 
53 

54 

55 — Display all local variable names: 

56 

57 Environment_Mgt . Get_all_names ( 

58 group_name => System_Defs.null_text, 

59 list => variable_name_list, 

60 global => false); 
61 

62 Text_IO.Put_line("List of local variables:"); 

63 

64 for i in 1 .. variable_name_list. count loop 

65 

66 String_List_Mgt.Get_element ( 

67 from => variable_name_list, 

68 el_pos => i, 

69 element => variable_name) ; 
70 

71 Text_IO.Put_line (variable_name. value) ; 

72 

73 end loop; 

74 
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— Read type and mode of given variable: 

If integer and read-write, add one to variable- 
otherwise, read and display ASCII 
representation of value: 

Text_IO. Put ("Enter a variable name:" ); 

Text_IO.Get (variable_name. value) ; 

variable_type := Environment_Mgt .Get_var_type ( 
var_name => variable_name) ; 

variable_mode := Environment_Mgt.Get_var_mode ( 
var_name => variable_name) ; 

if variable_type = CL_Defs.integer_type then 

integer_value := Environment_Mgt.Get_integer ( 
var_name => variable_name) ; 

Text_IO. Put ("Original value of "); 
Text_IO.Put (variable_name. value) ; 
Text_IO.Put (" integer variable is:"); 
Int_IO.Put (integer_value) ; 
Text_IO.Put_line (" ") ; 

if variable_mode » CL_Defs.read_write then 
integer_value := integer_value +1; 

Environment_Mgt . Set_integer ( 
var_name => variable_name, 
value => integer_value) ; 

Text_IO.Put ("New value of "); 
Text_IO.Put (variable_name. value) ; 
Text_IO.Put (" integer variable is:"); 
Int_I0.Put (integer_value) ; 
Text_IO.Put_line (" ") ; 

else 

Text_IO. Put ("Mode of ") ; 

Text_IO.Put (variable_name. value) ; 

Text 10. Put line(" integer variable is 'read-only'.") 



end if; 
else 



— if "read_write" 

— not "integer_type" 



Environment_Mgt .Convert_and_get ( 
var_name ==> variable_name, 
value => ASCII_value) ; 

Text_IO. Put ("Value of "); 
Text_IO.Put (variable_name. value) ; 
Text_IO.Put (" variable is:"); 
Text_IO.Put_line (ASCII_value. value) ; 

if variable_mode = CL_Defs.read_write then 

Text_I0 . Put ( "Change value ?") ; 

Text_IO.Get (answer) ; 

if answer = 'y' or 
answer = 'Y' then 

Text_I0. Put ("Enter new value:"); 
Text_I0.Get (ASCII_value. value) ; 

Environment_Mgt . Convert_and_set ( 
var_name => variable_name, 
value => ASCII_value, 
var_type => variable_type) ; 



end if; 



— if answer = 'y' 
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152 else 

153 Text_IO. Put ("Mode of "); 

154 Text_IO.Put (variable_name. value) ; 

155 Text_IO.Put_line(" variable is * read-only '.") ; 
156 

157 end if; — if mode = read_write 

158 

159 end if; — if "integer_type" 

160 

161 

162 — • Remove new variable: 

163 

164 Text_Mgt . Set ( 

165 dest => variable_name, 

166 source => "new_integer"); 
167 

168 Envi ronment_Mgt . Remove ( 

169 var_name => variable_name, 

170 quiet => true, 

171 global => false) ; 
172 

173 end Manage_Application_Environment_Ex; 
174 
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X-A.2.6 string_list_ex Procedure 



1 with String_List_Mgt, 

2 System_Defs; 
3 

4 procedure String_list_ex 
5 

6 — Function: 

7 — Create string list with following entries: 

8 — 1. "ux_group" 

9 — 2. "world" 

10 is 

11 string_list: System_Defs.string_list (255) ; 

12 begin 
13 

14 — 1) "ux_group" 

15 String_List_Mgt.Set (string_list, 

16 System_Defs.text' (8, 8, "ux_group") ) ; 
17 

18 — 2) "world" 

19 String_List_Mgt .Append (string_list, 

20 System_Defs.text' (5, 5, "world")); 
21 

22 end String_list_ex; 
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X-A.3.1 Create_directory_cmd_ex Procedure 



1 with CommandJHandler, 

2 DeviceJDefs, 

3 Directory_Mgt, / 

4 System_Defs; ^ 
5 

6 procedure Create_directory_cmd_ex 
7 

8 — Function: 

9 — Creates a named subdirectory in the 
10 -- caller's current directory. 

11 

12 — Command Definition: 

13 — The command has the form: 

14 ■ — create. directory :name=<string> 
15 

16 — Create the command definition by entering: 

17 — | clex -> manage . program :tagged_source=create.dir.sb 
18 

X9 *— ***0* s@t ■ i^irocrc etni c2T@flLfc©«ciiir€CwOiry 

20 — *d* 

21 — *D* manage . commands 

22 ~*D* 

23 — *D* create. invocation_command 

24 — *d* define. argument name :type - string 

25 — *D* set.lexical_class symbolic_name 

26 — *D* set . maximum_length 252 

27 — *D* set .mandatory 

28 — *D* set. description -.text = " 

29 — *D* — Name of directory to be created. 

30 — *d* " 

31 — *d* end 

32 — *D* set. description :text = " 

33 — *D* — Creates a directory in the 

34 — *D* — current directory. 

35 __* D * 

36 -- *D* end 

37 — *D* exit — manage . commands 

38 — *D* exit — manage. program 

39 \ 

40 is 
41 

42 opened_command: Device_Defs.opened_device; 

43 — Opened invocation command input device. 
44 

45 dir_name: System_Def s. text (252) ; 

46 — Name of the directory to be created. 
47 

48 dir_AD: Directory_Mgt. direct ory_AD; 

49 — Newly created directory's AD; returned 

50 — but not used by "create. directory". 

51 begin 
52 

53 — Open invocation command input device: 
54 

55 opened_command := Command_Handler. 

56 Open_invocation_command_processing; 
57 

58 — Get ":name" parameter: 
59 

60 Command_Handler.Get_string( 

61 cmd_odo => opened_command, 

62 arg_number => 1, 

63 arg_value => dir_name) ; 
64 

65 — Close invocation command input device: 

66 

67 Command_Handler. Close (opened_command) ; 

68 

69 

70 — Create new named directory: 

71 

72 dir_AD := Directory_Mgt .Create_direetory ( 

73 name ==> dir_name) ; 
74 
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75 end Create_directory_cmd_ex; 
76 
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X-A.3.2 Create_name_space_cmd_ex Procedure 



1 with CL_Defs, 

2 Command_Handler, 

3 Device_Defs, 

4 Directory_Mgt, 

5 Envi ronment_Mgt , 

6 Example_Messages, — Example package. 

7 Incident_Defs, 

8 Message_Services, 

9 Name_Space_Mgt , 

10 Passive_Store_Mgt, 

11 String_List_Mgt, 

12 System, 

13 System_Defs, 

14 SystemJBxceptions, 

15 Transact ion_Mgt; 
16 

17 procedure Create_name_space_cmd_ex 
18 

19 — Functions 

20 — Defines a command to create a name space, 

21 — along with the code that executes the command. 
22 

23 — Command Definition: 

24 — The command has the form: 
25 

26 — create. name_space 

27 — :name=<string> 

28 — :directory_list=<string_list> 

29 — [ : force=<boolean>:=false] 
30 

31 — Pathnames in the directory list must name 

32 — directories. 
33 

34 — If "force" is omitted or false then the "name" 

35 — pathname must not be in use. If "force" is 

36 — true and the "name" pathname is in use, then 

37 — the environment variable "user. confirm" is 

38 — consulted. If "user. confirm" is true (or does 

39 — not exist) , then the user is queried before 

40 — deleting the existing use of the pathname. 
41 

42 — *C* set .message_file \ 

43 — *C* :file = /examples/msg/example_messages 

44 ~*c* 

45 — *C* create . command \ 

46 — *C* :cmd_def = create. n_s.inv_cmd \ 

47 — *C* :cmd_name = create . name_space 

48 ~*c* 

49 — *C* define. argument name \ 

50 — *C* :type = string 

51 — *C* set.lexical_class symbolic_name 

52 — *C* set .maximum_length 252 

53 — *C* set .mandatory 

54 — *c* end 

55 — *c* 

56 — *C* define. argument directory_list \ 

57 — *C* :type = string_list 

58 — *C* set .lexical_class symbolic_name 

59 — *C* set.maximum_length 508 

60 — *C* end 

61 — *C* 

62 — *C* define. argument force \ 

63 — *C* :type = boolean 

64 — *C* set.value_default false 

65 — *C* end 

66 — *C* end 

67 ~*c* 

68 — *C* run "store. command_definitions \\ 

69 — *C* :exec_unit = create. n_s \\ 

70 — *C* :invocation_cmd = create. n_s.inv_cmd" 

71 — *C* 

72 — *C* run "store. default_message_file \\ 

73 — * c * create. n_s \\ 

74 — *C* /examples/msg/example messages 
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75 

76 

77 

78 is 

79 

80 opened_cmd: Device_Defs.opened_device; 

81 — Opened command input device. 
82 

83 name: System_Defs.text (Incident_Defs.txt_length) ; 

84 — Pathname of new name space. 
85 

86 directory_list: System_Defs.string_list (508) ; 

87 — String list containing pathnames of the 

88 — directories in the new name space. 
89 

90 force: boolean; 

91 — Whether the new name space's pathname should 

92 — overwrite an existing entry. 
93 

94 i: natural; 

95 — Index into "directory_list". 
96 

97 directoryjpath: System_Defs.text (Incident_Defs.txt_length) 

98 — Text containing each successive pathname from 

99 — "directory_list". 
100 

101 valid: boolean := true; 

102 — True if "directory_list" is valid. Assigned 

103 — false if it is invalid. 
104 

105 name_space : Name_Space_Mgt . name_space_AD ; 

106 — The new name space. 
107 

108 name_space_untyped : System. untyped_word; 

109 FOR name_space_untyped USE AT name_space' address; 

110 — The new name space as an untyped word. 
Ill 

112 user_confirm_name: constant System_Defs.text ( 

113 12) := {12, 12, "user. confirm"); 

114 — Text record of an environment variable's name. 
115 

116 user_confirm_var_exists: boolean; 

117 — Whether a user variable named 

118 — "user. confirm" exists. 
119 

120 user_confirm_var: boolean; 

121 — Value of "user. confirm" variable, if it exists 

122 — ("user_confirm_var_exists" is true) . 
123 

124 overwrite: boolean; 

125 — Whether the created name space can overwrite an 

126 — existing entry with the same pathname. 
127 

128 

129 begin 

130 

131 — Get command arguments: 

132 

133 opened_cmd := Command_Handler. 

134 Open_invocation_command_processing; 
135 

136 — Get first argument (name of new name space) : 
137 

138 Command_Handler.Get_string(opened_cmd, 1, 

139 arg_value => name); 
140 

141 — Get second argument (list of directories) : 
142 

143 Command_Handler.Get_string_list (opened_cmd, 2, 

144 arg_value => direct ory_list) ; 
145 

146 — Get third argument (force overwrite) : 

147 

148 force := Command_Handler.Get_boolean (opened_cmd, 3); 

149 

150 

151 Command Handler. Close (opened cmd) ; 
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152 

153 

154 — Check each pathname in the directory list: 

155 

156 i := 1; (■■ 

157 \ 

158 loop 
159 

160 String_List_Mgt . Get_element_by_index { 

161 from => directory_list, 

162 list_index => i, 

163 element => directoryjpath) ; 
164 

165 — Exit after last string: 

166 

167 EXIT when i - 0; 

168 

169 — Check if pathname exists, and is a directory: 

170 

171 begin 

172 if not Directory_Mgt. I s_di rectory ( 

173 Directory_Mgt. Retrieve (directory _path) ) then 
174 

175 valid := false; 
176 

177 Message_Services.Write_msg( 

178 ExamplejMes sages . not_directory_code, 

179 Incident_Defs.message_jparameter ( 

180 typ => Incident_Defs.txt, 

181 len => di rectory _path. length) ' ( 

182 typ => Incident_Defs.txt, 

183 len => directory _path. length, 

184 txt_val => directoryjpath) ) ; 

185 end if; 
186 

187 exception 

188 when Directory_Mgt .no_access => 
189 

190 valid := false; 

191 / 

192 Message_Services.Write_msg( \. 

193 Example_Messages.no_access_code, 

194 Incident_Def s.message_parameter ( 

195 typ => Incident__Defs.txt, 

196 len => directoryjpath. length) ' ( 

197 typ => Incident_Defs.txt, 

198 len => directoryjpath. length, 

199 txt_val => directory _path) ) ; 
200 

201 end; 

202 

203 end loop; 

204 

205 if not valid then 

206 Message_Services.Write_msg( 

207 Example_Messages. 

208 create_name_space_aborted_code) ; 

209 else 

210 name_space := Name_Space_Mgt .Create_name_space ( 

211 directory_list) ; 
212 

213 — Store new name space as a directory entry: 
214 

215 loop 

216 begin 
217 

218 — Start a transaction to store new name space: 

219 

220 Transaction_Mgt . Start_transaction; 

221 Directory _Mgt .Store (name, name_space_untyped) ; 
222 

223 — Exit if no exception raised: 

224 

225 EXIT; 

226 ^ 

227 exception \1 

228 ^ 
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when System_Exceptions. 

transact ion_timestamp_conflict => 

Transact ion_Mgt.Abort_transaction; 



when Directory_Mgt.entry_exists => 

Transact ion_Mgt.Abort_transact ion; 

if force then 

begin 

user_confirm_var := Environment_Mgt.Get_boolean( 
user_conf irm_name) ; 

user_confirm_var_exists := true; 

exception 

when CL_Defs.non_existent I 
CL_Defs.invalid_type I 
CL_Defs.no_value => 
user_confirm_var_exists :=» false; 
end; 

if user_confirm_var_exists and then 
(not user_confirm_var) then 

— No confirmation necessary: 

overwrite := true; 

else 

— Confirm overwrite: 

overwrite := 

Message_Services . Acknowledge_msg ( 
Example_Messages . 

overwrite_query_code , 
Incident_Def s . 

message_parameter ( 
typ => Incident_Defs.txt, 
len => name.max_length) ' ( 
typ => 

Incident_Def s . txt , 
len => 

name . max_lengt h , 
txt_val => name) ) ; 
end if; 

else 

— "force" false: 

overwrite := false; 
end if; 

if overwrite then 
begin 

Directory_Mgt. Delete (name) ; 

exception 

when Directory_Mgt.no_access => 
null; 
end; 

else 

Message_Services.Write_msg ( 

Example_Messages.not_overwritten_code, 
Incident_Def s .message_parameter ( 
typ => Incident_Defs.txt, 
len => name.max_length) ' ( 

typ => Incident_Defs.txt, 
len => name.max_length, 
txt_val => name ) ) ; 

Message_Services.Write_msg( 
Example_Messages. 

creat e_name_space_abort ed_code ) ; 
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306 end if; 

307 

308 when Directory_Mgt.no_access => 

309 

310 Transaction_Mgt.Abort_transaction; f 

311 \ 

312 Message_Services.Write_msg( 

313 Example_Messages . no_access_code, 

314 Incident_Def s.message_parameter { 

315 typ => Incident_Defs.txt, 

316 len => name.max_length) ' ( 

317 typ => Incident_Defs.txt, 

318 len => name.max_length, 

319 txt_val => name)); 
320 

321 Message_Services.Write_msg( 

322 Example_Messages. 

323 create_name_space_aborted_code) ; 
324 

325 when others => 

326 

327 Transaction_Mgt.Abort_transaction; 

328 

329 RAISE; 

330 

331 end; 

332 

333 end loop; 

334 

335 — Update passive version: 

336 

337 Passive_Store_Mgt .Request_update { 

338 name_space_untyped) ; 
339 

340 — Commit the "store new name space" transaction: 

341 

342 Transact ion_Mgt.Commit_transaction; 

343 

344 — Inform user of succesful creation of new name 

345 — space: , 
346 

347 Message_Services.Write_msg( ^ 

348 Example_Messages.name_space_created_code, 

349 Incident_Defs.message_parameter ( 

350 typ => Incident_Defs.txt, 

351 len => name. length) ' ( 

352 typ => Incident_Defs.txt, 

353 len => name. length, 

354 txt_val => name) ) ; 

355 end if; — if all directories in path are 

356 — valid 
357 

358 end Create_name_space_cmd_ex; 
359 
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X-A.3.3 List_ current_ directory_cmd_ex Procedure 

1 with Byte_Stream_AM, 

2 Command_Handler, 

3 Device_Defs, 

4 Directory_Mgt, 

5 Process_Mgt, 

6 Process_Mgt_Types, 

7 System, 

8 System_Defs, 

9 Unchecked_Conversion; 
10 

11 procedure List_current_directory_cmd_ex 
12 

13 — Function: 

14 — Lists names of entries in user's current 

15 — directory. 
16 

17 — Each entry name is written to the user's 

18 — standard output, on a separate line. 
19 

20 — Command Definition: 

21 — The command has the form: 

22 — li st. current_di rectory [:pattern=<string>] 
23 

24 — *d* manage . commands 

25 — *D* create. invocation_command 

26 — *D* 

27 — *D* define. argument pattern \ 

28 — *D* :type = string 

29 — *D* set.lexical_class symbolic_name 

30 — *D* set.maximum_length 252 

31 — *d* set.value_default "*" 

32 __*d* end 

33 __* D * en d 

34 __* D * 
35 

36 

37 is 

38 

39 — Generic function: 

40 

41 function Directory_AD_from_untyped_word is 

42 new Unchecked_conversion( 

43 source => System. untyped_word, 

44 target => Direct ory_Mgt.directory_AD) ; 
45 

46 

47 — Variables: 

48 

49 odo: Device_Defs.opened_device := 

50 Command_Handler. 

51 Open_invocation_command_processing; 

52 — Opened invocation command input device. 
53 

54 pattern: System_Defs. text (252) := (252, 252, (others => ' ')) 

55 — Optional ": pattern" used to select entries 

56 — matching the pattern, such as "abc?" or 

57 — "m*device". Default is "!.*", meaning all 

58 — entries NOT beginning with a "." (period). 
59 

60 opened_dir: Device_Defs.opened_device; 

61 — Opened device for reading stream of names 

62 — from user's current directory. 
63 

64 standard_output: Device_Defs.opened_device := 

65 Device_Defs.opened_device( 

66 Process_Mgt . Get_process_globals_entry ( 

67 Process_Mgt_Types . standard_output ) ) ; 

68 — User's standard output. 
69 

70 name_buffer: array (1 .. 250) of character; 

71 — Each entry name is read into this buffer 

72 — and then written from it. 
73 

74 length: System. ordinal ; 
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75 — Length in bytes (characters) of last 

76 — entry name read. 

77 use System; — for " 'size/8 " arithmetic 
78 

79 begin 

80 

81 — Get ":pattern", if any: 

82 

83 Command_Handler.Get_string( 

84 cmd_odo => odo, 

85 arg_number => 1, 

86 arg_value => pattern); 
87 

88 — Close invocation command input device: 

89 

90 Command_Handler . Close (odo) ; 

91 

92 — Open directory for reading, filtered by 

93 — ": pattern": 
94 

95 opened dir : s Directory Mgt.Qpen directory { 

96 dir => Direct ory_AD_f rom_untyped_word ( 

97 Process_Mgt .Get_process_globals_entry ( 

98 Process_Mgt_Types.current_dir) ) , 

99 pattern => pattern) ; 
100 

101 

102 — Get and write each entry name: 

103 

104 loop 

105 

106 length := Byte_Stream_AM.Ops.Read( 

107 opened_dev => opened_dir, 

108 buffer_VA => name_buffer' address, 

109 length => name_buffer' size/8) ; 
110 

111 Byte_Stream_AM.Ops.Write( 

112 opened_dev => standard_output, 

113 buffer_VA => name_buffer' address, 

114 length => length); 
115 

116 end loop; 

117 

118 exception 

119 

120 when Device_Defs.end_of_file => 

121 

122 By t e_Stream_AM.eps. CI ose(opened_dir) ; 

123 

124 RETURN; 

125 

126 end List_current_directory_cmd_ex; 

127 
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X-A.3.4 Make_object_public_ex Procedure 



1 with Author! ty_List_Mgt, 

2 Directory_Mgt, 

3 Identification_Mgt, 

4 Passive_Store_Mgt, 

5 System, 

6 System_Defs, 

7 Transaction_Mgt, 

8 User_Mgt; 
9 

10 procedure Make_object_public_ex( 

11 obj: System. untyped_word; 

12 — Object to be made public. 

13 aut_list_path: System_Defs.text) 

14 — Pathname under which to store the new 

15 — authority list. 
16 

17 — Function: 

18 — Makes an object "public" by giving it an 

19 — authority list that grants all type rights 

20 — to the "world" ID. 
21 

22 — Logic: 

23 — 1. Get an AD to the world ID. 

24 — 2. Define a protection set that grants all 

25 — type rights to the world ID. 

26 — 3. Create an authority list with that 

27 — protection set. 

28 — 4. Enclose steps (5) and (6) in a transaction. 

29 — 5. Store the authority list under the pathname 

30 — given as the "aut_list_path" parameter. 

31 — 6. Passivate the authority list, so that it 

32 — will endure in passive store along with 

33 — the object that it protects. 

34 — 7. Assign the authority list as the object's 

35 — authority list. 
36 

37 — Exceptions: 

38 — Authority_List_Mgt .set_authority_refused - 

39 — The object's master AD was stored with 

40 — no authority list protecting the object, 

41 — and an authority list cannot now be assigned. 

42 is 

43 — Get the world ID AD 

44 world__name: constant System_Defs.text (9) : = 

45 (9, 9, "/id/world"); 

46 world_untyped: constant System. untyped_word := 

47 Directory_Mgt .Retrieve (world_name) ; 

48 world_id: Identification_Mgt.ID_AD; 

49 FOR world_id USE AT world_untyped' address; 
50 

51 — Define the protection set 

52 entries: constant User_Mgt.protection_set (1) := ( 

53 size => 1, length => 1, 

54 entries => (1 => (rights => (true, true, true), 

55 id => world_id) ) ) ; 
56 

57 — Create the authority list 

58 aut_list: constant 

59 Authority_List_Mgt.authority_list_AD := 

60 Author! ty_List_Mgt.Create_authority (entries) ; 

61 aut_untyped: System. untyped_word; 

62 FOR aut_untyped USE AT aut_list 'address; 
63 

64 begin 

65 Transaction_Mgt . Start_transaction; 

66 begin 

67 Directory _Mgt. Store (aut_list_path, aut_untyped) ; 

68 Passive_Store_Mgt .Request_update (aut_untyped) ; 

69 Transaction_Mgt.Commit_transaction; 

70 exception 

71 when others => 

72 Transaction_Mgt .Abort_transaction; 

73 RAISE; 
74 
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75 end; 

76 Authority_List_Mgt . Set_ob ject_authority ( 

77 obj, aut_list); 

78 end Make object public ex; 
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X-A.3.5 Show_current_directory_cmd_ex Procedure 

1 with Byte_Stream_AM, 

2 Device_Defs, 

3 Directory_Mgt, 

4 Process_Mgt, 

5 Process_Mgt_Types, 

6 System, 

7 System_Defs, 

8 Text_Mgt; 
9 

10 procedure Show_current_directory_cmd_ex 
11 

12 — Function: 

13 — Gets and displays the pathname of the 

14 — current directory. 
15 

16 — Command Definition: 

17 — The command has the form: 

18 — show.current_directory 
19 

20 — *C* create . command \ 

21 — *C* :cmd_def = show.cur_dir.inv_cmd \ 

22 — *C* :cmd_name = show.current_directory 

23 — *c* end 

24 ~*c* 

25 — *C* run "store. command_defi nit ions \\ 

26 — *C* :exec_unit = show.cur_dir \\ 

27 — *C* :invocation_cmd = show.cur_dir.inv_cmd" 
28 

29 is 
30 

31 standard_output : Device_Defs.opened_device := 

32 Device_Defs.opened_device ( 

33 Process_Mgt . Get_process_globals_entry ( 

34 Process_Mgt_Types.standard_output) ) ; 

35 — User' s standard output . 
36 

37 current_dir: Directory_Mgt .directory_AD := 

38 Directory_Mgt . directory_AD ( 

39 Process_Mgt.Get_process_globals_entry ( 

40 Process_Mgt_Types.current_dir) ) ; 

41 — Current directory's AD. 
42 

43 current_dir_untyped: System. untyped_word; 

44 FOR current_dir_untyped USE AT 

45 current_dir' address; 

46 — Current directory's AD as an untyped word. 
47 

48 dir_name: System_Def s. text (252) ; 

49 — Current directory's name. 
50 

51 begin 

52 

53 — Get current directory's pathname: 

54 

55 Directory_Mgt .Get_name ( 

56 obj => current_dir_untyped, 

57 name => dir_name); 
58 

59 — Add a line-feed to pathname for displaying: 
60 

61 Text_Mgt . Append ( 

62 dest => dir_name, 

63 source => Standard.ASCII.LF) ; 
64 

65 — Display pathname: 
66 

67 Byte_Stream_AM. Ops. Write ( 

68 opened_dev => standard_output, 

69 buffer_VA => dir_name. value 'address, 

70 length => System. ordinal ( 

71 dir_name. length) ) ; 
72 

73 end Show_current_directory_cmd_ex; 
74 
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X-A.4 I/O Services 
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X-A.4.1 DBMS_Support_Ex Package Specification 



1 with Device_Defs, 

2 System, 

3 System_Defs; 
4 

5 package DBMS_Support_EX is 
6 

7 — Function: 

8 — Shows how to use the record processing and 

9 — DBMS support operations in applications. 
10 

11 — History: 

12 — 08-15-87, Paul Schwabe: initial version. 

13 — 12-01-87, Paul Schwabe: reorganized. 
14 

15 pragma external; 
16 

17 procedure Selection ( 

18 opened_file: Device_Defs.opened_device; 

19 read_procedure : System. subprogram_type) ; 

20 — An opened device, opened for input on an 

21 — employee file. 
22 

23 — Function: 

24 — Do a Record_AM.Keyed_Ops.Set_key_range using 

25 — the Dept index. Do a 

26 — Record_Processing_Support.Set_oriented_read. 

27 — Returns a set of records for the range of 

28 — departments indicated. 
29 

30 

31 procedure Projection ( 

32 opened_file: Device_Defs.opened_device; 

33 projection_DDef_name: System_Defs.text) ; 

34 — An opened device, opened for input on an 

35 — employee file. 
36 

37 — Function: 

38 — Grabs only certain fields for each record 

39 — that is read from the employee file. Set 

40 — the filter up using the following call: 
41 

42 

43 procedure Sort_records ( 

44 inventory_file: Device_Defs.opened_device; 

45 inventory_DDef_name: System_Defs.text) ; 

46 — An opened device, opened for input on an 

47 — inventory file. Uses 
48 

49 — Function: 

50 — Sort_Merge_Interf ace. Sort to sort records 

51 — from an inventory file (writes to standard 

52 — out) . 
53 

54 

55 procedure Merge_and_sort_records ( 

56 inventory_file: Device_Defs.opened_device; 

57 employee_file: Device_Defs.opened_device; 

58 sort_DDef_name: System_Def s. text) ; 

59 — Two opened devices, opened for input on an 

60 — inventory file and employee file. 
61 

62 — Function: 

63 — Uses Sort_Merge_Interface.Sort_merge to merge 

64 — and sort records from two (the inventory and 

65 — the employee) files (writes to standard out) . 
66 

67 

68 

69 end DBMSJSupportJEX; 

70 
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X-A.4.2 DBMS_Support jex Package Body 



1 with Employee_Filing_Ex, 

2 Data_Definition_Mgt, 

3 Device_Defs, 

4 Process_Globals_Support_Ex, 

5 Record_AM, 

6 Record_Processing_Support, 

7 Sort_Merge_Interface, 

8 Trusted_Record_Processing_Support, 

9 System, 

10 System_Defs, 

11 Unchecked_conversion; 
12 

13 use System; 

14 

15 package body DBMS_Support_Ex is 

16 

17 — Logic: 

18 — Shows how to do record processing 

19 — — support operations* 
20 

21 
22 

23 procedure Selection ( 

24 opened_file: Device_Defs.opened_device; 

25 read_procedure : System. subprogram_type) 

26 — An opened device, opened for input on an 

27 — employee file. 

28 — Logic: 

29 — Do a Record_AM.Keyed_Ops.Set_key_range using 

30 — the Dept index. Do a 

31 — Record_Processing_Support.Set_oriented_read. 

32 — Returns a set of records for the range of 

33 — departments indicated. 

34 is 

35 start_key_value: constant 

36 Employee_Filing_Ex.dept_key_buffer := ( 

37 dept => 100); 

38 — Lowest dept for ascending key field. 
39 

40 start_key_descr: constant 

41 Record_AM.key_value_descr :== ( 

42 start_key_value' address, 

43 start_key_value' size / 8) ; 
44 

45 stop_key_value : constant 

46 Employee_Filing_Ex.dept_key_buffer := { 

47 dept => 305); 

48 — Highest dept value 

49 — for ascending key field. 
50 

51 stop_key_descr: constant 

52 Record_AM.key_value_descr := ( 

53 stop_key_value' address, 

54 stop_key_value' size / 8); 
55 

56 begin 

57 Trusted_Record_Processing_Support . Associate_read_procedure ( 

58 opened_dev => opened_file, 

59 user_info => System. null_address, 

60 read_procedure => readjprocedure) ; 
61 

62 

63 Record_AM . Keyed_Ops . Set_key_range { 

64 opened_dev => opened_file, 

65 index => 

66 Employee_Filing_Ex.dept_index_name, 

67 select_range => ( 

68 start_comparison => Record_AM. inclusive, 

69 start_value => start_key_descr, 

70 stop_comparison => Record_AM. inclusive, 

71 stop_value => stop_key_descr) ) ; 
72 

73 Record_Processing_Support . Set_oriented_read ( 

74 opened_dev => opened_file, 
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modifier => Record_AM.next, 
output_device ■> Process_Globals_Support_Ex. 
Get_st andard_output , 
— Normally defaulted. 
alt_output => System. null_word, 
no_record_lock => false, 
lock => Record_AM.read_lock, 

unlock => Record_AM.no_unlock, 
timeout => Record_AM.wait_forever) ; 
— DO ANY NEEDED PROCESSING HERE. 

exception 

when Device_Defs.end_of_file => 
null; 

end Selection; 



procedure Projection ( 

opened_f ile: Device_Def s . opened_device; 
pro jection_DDef_name: System_Defs.text) 

— An opened device, opened for input on an 

— employee file. 
— Logic: 

Grabs only certain fields for each record 
that is read from the employee file. 



is 



projection DDef ref: 



Data_Def inition_Mgt , 
node reference; 



buffer: string{l .. integer (Employee_Filing_Ex.max_rec_size) ) 

— Buffer is large enough to hold any employee 

— record. 

current_record_addr: constant 

System. address := buffer' address; 
current_record_VA: constant 

Employee_Filing_Ex . employee_record_VA : = 
Employee_Filing_Ex . 

Employee_record_VA_f rom_VA ( 
current_record_addr) ; 

bytes_read: System. ordinal; 

— Number of bytes in current record. 

begin 

— Open projection data definition. 



projection_DDef_ref := 

Record_AM.Ops.Get_DDef ( 

opened_dev => Record_AM.Open_by_name ( 

name => pro jection_DDef_name, 
input_output => Device_Defs. input, 
allow => Device_Defs. readers, 
block => true) ) ; 

— Filters out all fields except those specified 

— in the DDef. 
Record_Processing_Support . 

Associate_primary_data_projection( 
opened_dev => opened_file, 
record_ID_output => false, 
primary_fields => pro jection_DDef_ref ) ; 



loop 

— Only reads the fields specified in 

— the DDef. 

bytes_read := Record_AM. Ops. Read ( 
opened_dev => opened_file, 
modifier => Record_AM.next, 

— Normally defaulted. 
buffer_VA => current_record_addr, 
length => System. ordinal ( 
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152 Employee_Filing_Ex.max_rec_size) ) ; 

153 

154 — DO ANY NEEDED PROCESSING HERE. 

155 

156 end loop; 

157 exception 

158 when Device_Defs.end_of_file => 

159 null; 
160 

161 end Projection; 

162 

163 

164 

165 procedure Sort_records { 

166 inventory_file: Device_Defs.opened_device; 

167 inventory _DDef_name: System_Defs.text) 

168 — An opened device, opened for input on an 

169 — inventory file. 

170 — Logic: 

171 — Uses Sort_Merge_Interf ace. Sort to sort 

172 — records from an inventory file (writes to 

173 — standard out) . 

174 is 

175 opened_inventory_ddef : Devi ce_Defs.opened_de vice; 

176 invent ory_ddef_ref : Data_Definition_Mgt. 

177 node_reference; 

178 begin 
179 

180 — Open inventory definition. 
181 

182 opened_inventory_DDef := 

183 Record_AM.Open_by_name( 

184 name => inventory_DDef_name, 

185 input_output => Device_Defs. input, 

186 allow => Device_Defs. readers, 

187 block => true); 
188 

189 inventory_DDef_ref := 

190 Record_AM.Ops.Get_DDef ( 

191 opened_dev => opened_inventory_DDef ) ; 
192 

1 93 Sort_Merge_Inter f ace . Sort ( 

194 input_device => inventory_file, 

195 DDef => inventory__DDef_ref, 

196 output_device => Process_Globals_Support_Ex. 

197 Get_standard_output, 

198 stable_sort => true, 

199 tuning_opts => Sort_Merge_Interface. 

200 no_tuning) ; 
201 

202 — Close inventory file. 
203 

204 Record_AM. Ops. Close ( 

205 opened_dev => opened_inventory_DDef ) ; 
206 

207 end Sort_records; 

208 

209 

210 procedure Merge_and_sort_records ( 

211 inventory_file: Device_Defs.opened_device; 

212 employee_file: Device_Defs.opened_device; 

213 sort_DDef_name: System_Defs.text) 

214 — Two opened devices, opened for input on an 

215 — inventory file and employee file. Uses 

216 — Logic: 

217 — Sort_Merge_Interface.Sort_merge to merge 

218 — and sort records from two (the inventory 

219 — and the employee) files (writes to 

220 — standard out) . 

221 is 

222 opened_sort_DDef : Device_Defs.opened_device; 

223 sort_DDef_ref : Data_Def inition_Mgt . 

224 node_reference; 

225 sort_input_array: Sort_Merge_Interface. 

226 sort_merge_input_array (1 .. 2) := 

227 (1 => (input_device => inventory_file, 

228 presorted => false, 
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229 sorted_by_index => false), 

230 2 =>> (input_device »> employee_file, 

231 presorted => false, 

232 sorted_by_index => false)); 

233 begin 
234 

235 — Open sort data definition. 
236 

237 opened_sort_DDef := 

238 Record_AM . Open_by_name ( 

239 name => sort_DDef_name, 

240 input_output => Devi ce_Defs. input, 

241 allow => Device_Defs. readers, 

242 block => true) ; 
243 

244 sort_DDef_ref : = 

245 Record_AM.Ops.Get_DDef ( 

246 opened_dev => opened_sort_DDef ) ; 
247 

248 — Perform the sort -merge. 

249 Sort_Merge_Interf ace . Sort_merge ( 

250 input_devices => sort_input_array, 

251 DDef => sort_DDef_ref, 

252 output_device => Process_Globals_Support_EX. 

253 Get_standard_output, 

254 stable_sort => true, 

255 tuning_opts => Sort_Merge_Interface. 

256 no_tuning) ; 
257 

258 

259 — Close inventory file. 

260 

261 Record_AM. Ops. Close ( 

262 opened_dev => opened_sort_DDef ) ; 
263 

264 end Merge_and_sort_records; 

265 

266 

267 end DBMS_Support_EX; 
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X-A.4.3 Empioyee_Fiiing_Ex Package Specification 



1 with Data_Definition_Mgt, 

2 File_Defs, 

3 System, 

4 System_Defs, 

5 Unchecked_conversion; 
6 

7 use System; 
8 

9 package Employee_Filing_Ex is 
10 

11 — Function: 

12 — Defines an employee file structure. 
13 

14 

15 — Contains declarations for employee records and 

16 — indexes. Contains subprograms for creating 

17 — needed DDefs and for creating an employee file 

18 — with indexes. 
19 

20 — The "employee_record" type defines the record 

21 — format. 
22 

23 — An employee file has two indexes: 
24 

25 — "Dept index" - A b-tree index sorted by salary 

26 — ascending department. Allows duplicates. 
27 

28 — "Dept -salary" index - A b-tree index 

29 — sorted by ascending department and descending 

30 • — salary. Allows duplicates. 
31 

32 pragma external; 

33 

34 

35 — CONSTANTS 

36 

37 

38 max_text_length: constant := 25; 

39 — The maximum length for a person's 

40 — name. 

41 max_job_desc_length: constant := 200; 

42 — The maximum length of a job description 

43 — string. 
44 

45 

46 — FIELD SUBTYPES OR TYPES 

47 

48 subtype department_number is 

49 System. ordinal range .. 1000; 

50 — A work group within the company. 
51 

52 subtype person_name is 

53 System_Defs.text (max_text_length) ; 
54 

55 — Format is: last-name, first-name middle-name 

56 — [suffix ] This format is used so that records 

57 — can be ordered alphabetically on last name then 

58 — first name. 
59 

60 subtype job_description_length is 

61 integer range . . max_job_desc_length; 

62 — String length allowed for a job 

63 — description. 
64 

65 subtype monthly_salary is float; 

66 — The monthly salary for an employee. 
67 

68 

69 — RECORD DECLARATIONS 

70 

71 type employee_record( 

72 length: job_description_length) is 

73 record 

74 dept: department number; 



X-A-42 



PRELIMINARY 



75 

76 

77 

78 

79 

80 

81 

82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

100 

101 

102 

103 

104 

105 

106 

107 

108 

109 

110 

111 

112 

113 

114 

115 

116 

117 

118 

119 

120 

121 

122 

123 

124 

125 

126 

127 

128 

129 

130 

131 

132 

133 

134 

135 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 

146 

147 

148 

149 

150 

151 



job_descr: 
salary: 
end record; 



person_name; 

string (1 .. length); 

monthly salary; 



— This specific representation assures the 

— record is correctly represented for the 

— DDef. The fields must be word aligned. 



FOR employee_record USE 



record 

dept 

name 

salary 
end record; 



range 
4 range 
at 36 range 



at 
at 



31; 

231j 

63; 



max_rec_size: constant System. ordinal := 241; 

— Maximum number of bytes in the employee record. 

— Used to determine the buffer size when 

— reading an employee record. 

type employee_record_VA is access employee_record; 
pragma access_kind (employee_record_VA, virtual); 

— Type contains virtual pointers to employee 

— records. 

employee_DDef : Data_Def inition_Mgt . node_reference; 

— Data definition for the employee record. 



~ DECLARATIONS FOR INDEXES 

— A simple index declaration. 
dept_index_DDef : Data_Def inition_Mgt . 

node_re f e rence ; 

dept_index_name: constant 
File_Defs.index_name := 

(max_length => File_Defs.index_name_length, 
length => 14, 
value => "Dept_Index_DDef "); 

type dept_key_buffer is 
record 

dept : department_number; 
end record; 

— A composite index declaration. 
dept_salary_index_DDef : 

Data_Definition_Mgt.node_reference; 

dept_salary_index_name: constant 
F i 1 e_De f s . i ndex_name : = 

(max_length => File_Defs.index_name_length, 
length => 21, 
value => "Dept_Salary_Index_DDef 

type dept salary key buffer is 
record 

dept : department_number; 
salary: monthly_salary; 
end record; 

— This specific representation assures the 

— buffer is correctly represented for the 

— DDef. There is no padding between fields. 
FOR dept_salary_key_buffer USE 

record 

dept at range .. 31; 

salary at 4 range . . 63; 

end record; 



— CALLS 



function Employee_record_VA_from_VA is new 



") 
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152 Unchecked_conversion ( 

153 source => System. address, 

154 target => employee_record_VA) ; 
155 

156 

157 function VA_from_employee_record_VA is new 

158 Unchecked_conversion ( 

159 source => employee_record_VA, 

160 target => System. address) ; 
161 

162 

163 

164 procedure Create_employee_DDef; 

165 

166 — Function: 

167 — Creates DDefs for the employee record and all 

168 — indexes. 
169 

170 — The DDefs are in a single DDef object, which 

171 — is passivated with the specified pathname. 
172 

173 — n Create_employee_DDefs" assigns all the 

174 — "ddef" variables in this package. 
175 

176 — Notes: 

177 — "Create_employee_DDefs" is normally called 

178 — only once in the lifetime of a system. 
179 

180 — The same DDefs can be used by multiple 

181 — employee files. 
182 

183 

184 procedure Create_dept_DDef ; 

185 . ~ 

186 — Function: 

187 — Sets up an index key DDef for an employee 

188 — file by deriving fields from an existing 

189 — record DDef. 
190 

191 — The index key DDef requires the properties 

192 — indicated by the following pseudo-DDef 

193 — language: 
194 

195 ~ define "Dept" 

196 — record Import from ( 

197 — "Employee_Data", 

198 — "Employee_DDef"), 

199 — Derive_all is false; 

200 — Maps to "Dept", 

201 — This simple index key is set up by mapping 

202 — DDef nodes from "Employee_DDef " to a new 

203 — record DDef called "Index_2_DDef" 

204 — that consists of one field: 

205 — * "Dept" in ascending order. 
206 

207 procedure Create_dept_salary_DDef; 
208 

209 — Function: 

210 — Sets up an index key DDef for an employee 

211 — file by deriving fields from an existing 

212 , ~ record DDef. 
213 

214 — The index key DDef requires the properties 

215 — indicated by the following pseudo-DDef 

216 — language: 
217 

218 — define "Dept-Salary" 

219 — record Import from ( 

220 — "Employee_Data", 

221 — "Employee_DDef") , 

222 — Derive_all is false; 

223 ~ Maps to "Dept", 

224 — Maps to "Salary", 

225 — descending is true; 
226 

227 — This composite index key is set up by mapping 

228 — DDef nodes from "Employee DDef" to a new 
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229 — record DDef called "Dept-Salary" 

230 — that consists of two fields: 

231 — * "Dept" in ascending order. 

232 — * "Salary" in descending order. 
233 

234 

235 procedure Create_f ile_and_indexes ( 

236 file_name: System_Def s.text; 

237 org_index_name: System_Def s.text) ; 

238 — New file's pathname. 
239 

240 — Function: 

241 — Creates an employee file with all needed 

242 — indexes. The employee file is a clustered 

243 — organization. 
244 

245 — The new file is initially empty. 
246 

247 — "Create_employee_DDefs" must have been called 

248 — *before* any call to "Create_employee_file". 
249 

250 — Note: 

251 — The index is built after the file is created. 
252 

253 — The file uses DDefs defined in the 

254 — Employee_Filing_Ex package. 
255 

256 

257 end Employee_Filing_Ex; 

258 
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X-A.4.4 Employee_Filing_ Ex Package Body 



1 with Data_Definition_Mgt, 

2 Direct ory_Mgt, 

3 File_Admin, 

4 File_Defs f 

5 Passive_Store_Mgt, 

6 System, 

7 System_Defs, 

8 Text_Mgt; 
9 

10 package body Employee_Filing_Ex is 
11 

12 max_employee_count: System. ordinal := 1_000; 

13 — A new employee file is limited to this many 

14 — employees. 
15 

16 

17 procedure Store_DDef( 

18 DDef: Data_Definition_Mgt.DDef_AD; 

19 name: System_Defs.text) 

20 is 

21 — Logic: 

22 — Stores a DOef and updates its passive 

23 — version. 
24 

25 untyped_DDef : untyped_word; 

26 FOR untyped_DDef USE AT DDef 'address; 
27 

28 begin 

29 begin 

30 Directory_Mgt .Delete (name) ; 

31 exception 

32 when Directory _Mgt.no_access => 

33 null; 
34 

35 when others => 

36 RAISE; 

37 end; 

38 Directory _Mgt. Store (name, untyped_DDef ) ; 
39 

40 Passive_Store_Mgt .Request_update (untyped_DDef ) ; 

41 

42 end Store_DDef; 

43 

44 procedure Create_employee_DDef 

45 — New DDef object's pathname. 
46 

47 — Logic: 

48 — Sets up a self-contained record DDef. This 

49 — DDef requires the properties indicated by 

50 — the following pseudo-DDef language: 
51 

52 — define Employee_Data 

53 — record 

54 — Dept: Type is ord_2, 

55 — lower_bound is 100, 

56 — upper_bound is 999; 

57 — Name: Type is string, 

58 — (System_Defs.text) 

59 — Header_for_max_length is true, 

60 — Varying is true, 

61 — length is 25; 

62 — Job_Desc: Type is string, 

63 — length is 200; 

64 — Salary: Type is real 4, 

65 — default_value is 0; 

66 — end record; 
67 

68 — This structure is equivalent to the following 

69 — Ada record declaration: 
70 

71 — subtype Job_Desc_length is 

72 — integer range 0.. 200; 
73 

74 — Employee_Data( 
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length: Job Desc length) is 



record 

dept : 

name: 

job_Desc: 

salary: 
end record; 



short_ordinal range 100 
System_Defs.text (25) ; 
string (1 .. length); 
float; 



999; 



"Data_Definition_Mgt" assigns layout 
properties to the record that correspond to 
the following Ada rep spec (note that the 
holes in the record allow fields to be placed 
on natural boundaries) : 

for Employee_Data use 
record 

dept at range .. 15; 
name at 4 range . . 

8* (max_text_length+4) -1; 
length at 40 range .. 15; 
job_desc at 42 range . . 

8* ( job_desc_length) -1; 
salary at 36 range .. 31; 
end record; 



is 



dd: Data_Definition_Mgt.DDef_AD; 
name: System_Defs.text (40) ; 
rec_node: Data_Definition_Mgt.node_reference; 
field_node: Data_Definition_Mgt.node_reference; 
pv: Data_Definition_Mgt .property_value (100) ; 
begin 

dd := Data_Definition_Mgt.Create_DDef; 
— Create a new DDef object. 



Text_Mgt . Set (name, "EmployeeJData") ; 
rec_node := Data_Definition_Mgt.Create_node ( 
— Create a DDef node for the record layout, 
dd, 

— AD to a DDef object 
Data_Def inition_Mgt .mt_record, 

— Record metatype and property value for 

— the "node_name" property ID. 
name, 

Data_Def inition_Mgt .public_root_node) ; 

— Property value for the "root_value" 

— property ID. 



Text_Mgt . Set (name, "Dept") ; 

— Create a simple metatype node with 

— "root_value" set to "non_root_node" for the 

— "Dept" field. 

field_node := Data_Definition_Mgt. 
Create_simple_f ield ( 
rec_node, 

— DDef object open for definition. 
Data_Definition_Mgt.t_ord2, 

— Property value for "pi^ype" property 

— ID (short ordinal of type "type_t") . 
name ) ; 

— Property value for the "node_name" 

— property ID. 

pv.simple_pv := ( 

pv_type => Data_Definition_Mgt.pv_int4, 
int4_value => 100); 

— Set "pi_lower_bounds" (type integer) to 

— 100. 

— Add "pi_lower_bounds" and its value to the 

— "Dept" node. 

Data_Def inition_Mgt . Add_property_value ( 
field_node, 
Data_Definition_Mgt.pi_lower_bounds, 
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152 pv) ; 
153 

154 pv.simple_pv.int4_value := 999; 

155 — Set "upper_bounds" property value. 
156 

157 Data_Definition_Mgt . Add_property_value ( 

158 — Add "pi_upper_bounds" and its value to the 

159 — node. 

160 field_node, 

161 Data_Def inition_Mgt .pi_upper_bounds, 

162 pv); 
163 

164 

165 Text_Mgt.Set (name, "Name") ; 

166 

167 — Create a simple metatype node with 

168 — "root_value" set to "non_root_node" for the 

169 — "Name- field. 

170 field_node := Data_Definition_Mgt. 

171 Create_simple_f ield_with_prop ( 

172 rec_node, 

173 — DDef object that is open for 

174 ~ definition. 

175 Data_Definition_Mgt.t_string, 

176 — Value for "pi_type" (uses byte-string 

177 — for "type_t") . 

178 name, 

179 — Value for "node_name". 

180 Data_Definition_Mgt. 

181 pi_header_for_max_length, 

182 (Data_Definition_Mgt.pv_boolean, true) ) ; 

183 — ■ True if string is represented in 

184 — SIL 'text' type. 
185 

186 pv.simple_pv := ( 

187 pv_type => Data_Definition_Mgt.pv_int4, 

188 int4_value => 25); 

189 — Property value (type integer) is set to 

190 -- 25. 
191 

192 Data_Definition_Mgt.Add_property_value ( 

193 field_node, 

194 — Node within an open DDef object. 

195 Data_Definition_Mgt.pi_length, 

196 pv); 

197 — Sets "pi_length" (maximum length of string in 

198 — bytes) . Because "pi_header_for_max_length n 

199 — requires "pi_varying" to be false, "name" is 

200 — a fixed-size field. 
201 

202 

203 Text_Mgt.Set (name, "Job_Desc") ; 

204 

205 — Create a simple metatype node with 

206 — "root_value" set to "non_root_node". 

207 field_node := Data_Definition_Mgt. 

208 Create_simple_f ield_with_prop ( 

209 rec_node, 

210 — DDef object that is open for 

211 — definition. 

212 Data_Def inition_Mgt . t_string, 

213 — Value for "pi_type" (uses 

214 — byte-string for "type_t") . 

215 name, 

216 — Value for "pi_node_name". 

217 Data_Definition_Mgt.pi_varying, 

218 (Data_Definition_Mgt.pv_boolean, 

219 true)); 

220 — Varying-length string. 
221 

222 pv.simple_pv := ( 

223 pv_type => Data_Definition_Mgt.pv_int4, 

224 — Sets property value for "pi_length" 

225 — (maximum length of string in bytes) to 

226 — 200. 

227 int4_value => 200); 
228 
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Data_Def inition_Mgt . Add_property_value ( 
— Adds "pi_length" and its value. 
field_node, 

— Node within an open DDef object. 
Data_Definition_Mgt.pi_length, 
pv); 



Text_Mgt . Set (name, "Salary" ) ; 
field_node := Data_Definition_Mgt. 
Create_simple_f ield_with_prop ( 

— Create a simple metatype node with 

— "root_value" set to "non_root_node" 

— (defaults to 0) . 
rec_node, 

— DDef object that is open for 

— definition. 
Data_Definltion_Mgt.t_real8, 

— Value for "pi_type" 

— (uses real for "type_t n ) . 
name, 

— Value for "p^node^jiame''. 
Data_Definition_Mgt.pi_default_value, 
(Data_Definition_Mgt.pv_real8, 0.0) ) ; 

Data_Definition_Mgt .Close (dd) ; 
— Close and bind DDef object. 

— Save created DDef as "Employee_DDef". 
Text_Mgt .Set (name, "Employee_DDef ") ; 
Store DDef (DDef => dd, name => name); 



end Create employee DDef; 



procedure Create_dept_DDef 

— Logic: 

— Sets up an index key DDef for an employee 
file by deriving fields from an existing 
record DDef. 

is 

dd: Data_Def inition_Mgt . DDef_AD; 

name: System_Defs.text (40) ; 

rec_node : Data_Def inition_Mgt . node_ref erence; 

field_node: Data_Definition_Mgt.node_ref erence; 

pv: Data_Definition_Mgt. 

property_value (100) ; 
begin 

— Create AD to a DDef object 

dd := Data_Definition_Mgt.Create_DDef; 

— Create node for Index_2_DDef record 
Text_Mgt . Set (name, "Index_2_DDef " ) ; 
rec_node := Data_Definition_Mgt.Create_node ( 

dd, 

— AD to a DDef object 
Data_Def inition_Mgt .mt_record, 

meta_type of ' record' 
name, 

— value for the node_name 

— property 

Data_Def inition_Mgt .private_root_node) ; 

— can be referenced from 

— other DDef objects 

— Set DDef_name property 
pv.simple_pv := ( 

pv_type => Data_Definition_Mgt.pv_string) ; 

Text_Mgt.Set (pv.text_value, "Employee_Data") ; 

Data_Def inition_Mgt . Add_property__value ( 
rec_node, 

— node within an open DDef 
Data_Definition_Mgt.pi_DDef_name, 

— requested property 
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306 pv); 

307 — value to be assigned 

308 Text_Mgt.Set (pv.text_value, "Employee_DDef ") ; 

309 Data_Definition_Mgt .Add_jproperty_yalue ( 

310 rec_node, 

311 — node within an open DDef 

312 Data_Def inition_Mgt .pi_DDef_name, 

313 — requested property 

314 pv); 

315 — value to be assigned 
316 

317 — Set derive_all property; false: all fields not 

318 — referred to. 

319 pv.simple_pv := ( 

320 pv_type => Data_Definition_Mgt.pv_boolean, 

321 — property value has type boolean 

322 boolean_value => false) ; 

323 Data_Definition_Mgt .Add_property_value { 

324 rec_node, 

325 — ■ node within an open DDef 

326 Data_Def inition_Mgt .pi_derive_all, 

327 — requested property 

328 pv) ; 

329 — value to be assigned 
330 

331 — Create node for key field "Dept" 

332 field_node := Data_Definition_Mgt. 

333 Create_field(rec_node) ; 

334 — first key. 
335 

336 — Set maps_to property 

337 pv.simple_pv := { 

338 pv_type => Data_Definition_Mgt.pv_string) ; 

339 Text_Mgt.Set (pv.text_value, "Dept_DDef ") ; 

340 Data_Definition_Mgt.Add_property_value ( 

341 field_node, 

342 — node within an open DDef 

343 Data_Definition_Mgt.pi_maps_to, 

344 — requested property 

345 pv) ; 

346 — value to be assigned 

347 — Descending defaults to false; 

348 — it needn't be set. 
349 

350 — close and bind DDef 

351 Data_Definition_Mgt. Close (dd) ; 
352 

353 — Save created DDef under the symbolic name 

354 — "Index_2_DDef" 

355 Text_Mgt . Set (name, "Dept_Index_DDef " ) ; 

356 Store_DDef (DDef => dd, name => name); 
357 

358 

359 end Create_dept_DDef ; 

360 

361 

362 

363 procedure Create_dept_salary_DDef 

364 

365 — Logic: 

366 — Sets up an index key DDef for an employee 

367 — file by deriving fields from an existing 

368 — record DDef. 
369 

370 is 

371 dd: Data_Definition_Mgt.DDef_AD; 

372 name: System_Defs.text (40) ; 

373 — New DDef object's pathname. 

374 rec_node: Data_Definition_Mgt .node_reference; 

375 field_node: Data_Definition_Mgt .node_reference; 

376 pv: Data_Definition_Mgt.property_value(100) 

377 begin 

378 — Create AD to a DDef object 

379 dd *— Data Definition Mgt«Create DDef; 
380 

381 — Create node for Employee_DDef record 

382 Text_Mgt . Set (name, "Employee_DDef ") ; 
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rec_node := Data_Definition_Mgt.Create_node ( 
dd, 

— AD to a DDef object 
Data_Def inition_Mgt . mt_record, 

— meta_type = record 
name, 

— Value for the node_name property 
Data_Def inition_Mgt .private_root_node) ; 

— Can be referenced from other DDef objects, 

— Set DDef_name property 
pv.simple_pv := ( 

pv_type => Data_Definition_Mgt.pv_string) ; 
Text_Mgt.Set (pv.text_value, "Employee_Data") ; 
Data_Def inition_Mgt . Add_property_value ( 

rec_node, 

— Node within an open DDef. 
Data_Def inition_Mgt . pi_DDef_name, 

— Requested property, 
pv) ; 

— Value to be assigned. 
Text_Mgt.Set (pv.text_value, "EmployeeJDDef") ; 
Data_Def inition_Mgt . Add_property_value ( 

rec_node, 

— Node within an open DDef. 
Data_Def inition_Mgt .pi_DDef_name, 

— Requested property. 
pv) ; 

— Value to be assigned. 

— Set derive_all property; false: all fields not 

— referred to. 
pv . simple_pv : = ( 

pv_type => Data_Definition_Mgt .pv_boolean, 
— property value has type boolean 

boolean_value => false); 
Data_Def inition_Mgt . Add_property_value ( 
rec_node, 

— node within an open DDef 
Data_Definition_Mgt.pi_derive_all, 

— requested property 
pv); 

— value to be assigned 

— Create node for key field "Dept" 
field_node := Data_Definition_Mgt. 

Create_field(rec_node) ; 
— first key. 

— Set maps_to property 
pv.simple_pv := ( 

pv_type => Data_Definition_Mgt.pv_string) ; 
Text_Mgt.Set (pv.text_value, "Dept"); 
Data_Def inition_Mgt . Add_property__value ( 

field_node, 

— node within an open DDef 
Data_Definition_Mgt.pi_maps_to, 

ra == requested property 
pv); 

— value to be assigned 

— Descending defaults to false; 

— it needn't be set. 

— Create node for key field "Salary" 
field_node := Data_Definition_Mgt .Create_field( 

rec_node) ; 

— Set maps_to property 
pv.simple_pv := ( 

pv_type => Data_Definition_Mgt.pv_string) ; 
Text_Mgt.Set (pv.text_value, "Salary"); 
Data_Def inition_Mgt . Add_property_value ( 

field_node, 

— node within an open DDef 
Data_Definition_Mgt .pi_maps_to, 

— requested property 
pv) ; 
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460 — value to be assigned 
461 

462 — Set descending property; true: order is 

463 — descending 

464 pv.simple_pv := ( 

465 P v _type => Data_Definition_Mgt.pv_boolean, 

466 — property value has type boolean 

467 boolean_value => true); 

468 Data_Def inition_Mgt . Add_property_value ( 

469 field_node, 

470 — node within an open DDef 

471 Data_Def inition_Mgt ,pi_descending, 

472 — requested property 

473 pv) ; 

474 — value to be assigned 
475 

476 — close and bind DDef 

477 Data_Definition_Mgt .Close (dd) ; 
478 

479 Text_Mgt . Set (name, "Dept_Salary_Index_DDef " ) ; 

480 Store_DDef (DDef => dd, name => name); 

481 — • Save created DDef under the symbolic name 

482 — "Index_DDef" 
483 

484 

485 end Create_dept_salary_DDef ; 

486 

487 

488 procedure Create_file_and_indexes( 

489 file_name: System_Defs.text; 

490 — New file's pathname. 

491 org_index_name: System_Defs.text) 

492 — Organization index's name. 
493 

494 — Logic: 

495 — Define descriptors for the file, the organization index, 

496 — and the alternate index. Create the file, build the 

497 — organization index, and build the alternate index. 
498 

499 — Note: 

500 — You build the organization index built after creating 

501 — the file, and the alternate index after creating the 

502 — organiztion index. 
503 

504 is 

505 new_file: File_Defs.file_AD; 

506 begin 

507 — Create the file first. 

508 new_file : = File_Admin.Create_file ( 

509 name => file_name, 

510 logical_file_descr => ( 

511 — Set the file's logical 

512 — file descriptor. 

513 file_org => File_Defs .unordered, 

514 DDef_specified => true, 

515 term_char => File_Defs.term_char, 

516 record_DDef => employee_DDef, 

517 record_layout => ( 

518 DDef_specified => true) , 

519 lock_escalation_count => 0, 

520 xm_locking => true, 

521 — Required for any record locking, 

522 — including transaction locking. 

523 short_term_logging => true, 

524 — Required for transaction support. 

525 long_term_logging => false, 

526 max_rec_num => 

527 max_empl oyee_coun t , 

528 bytes_per_bucket => 4096, 

529 fill_f actor => 

530 File_Admin. fill_factor_dont_care, 

531 org_index => org_index_name) ) ; 
532 

533 — Build the organization index for the file. 

534 File_Admin.Build_index ( 

535 file => new_file, 

536 logical_index_descr => ( 
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537 — Set the index descriptor for Department. 

538 name => dept__index_name, 

539 active =»> true, 

540 index_org »> 

541 File_Defs.btree_index, 

542 dupl i cat es_al lowed => false, 

543 duplicate_order => 

544 File_Defs.by_increasing_record_ID, 

545 null_attribute => File_Defs.none, 

546 DDef => dept_index_DDef , 

547 phantom_protected => false, 

548 utilization_maintenance => true, 

549 bytes_jper_bucket => 

550 File_Defs.page_size) ) ; 
551 

552 — Build an alternate index for the file. 

553 File_Admin.Build_index( 

554 file => new_file, 

555 logical_index_descr «■> ( 

556 name => 

557 dept_salary_index_name, 

558 active => true, 

559 index_org => 

560 File_Defs.btree_index, 

561 — A unordered org index with 

562 — a b-tree index. 

563 duplicates_allowed => false, 

564 duplicate_order => 

565 File_Defs.by_increasing_record_ID, 

566 null_attribute => 

567 File_Defs.none, 

568 DDef => 

569 dept_salary_index_DDef , 

570 phantom_protected => true, 

571 — Uses bucket-level locking. 

572 utilization_maintenance => true, 

573 bytes_per_bucket => 

574 File_Defs.page_size) ) ; 
575 

576 end Create_file_and_indexes; 

577 

578 end Employee_Filing_Ex; 

579 
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X-A.4.5 Hello ada ex Procedure 



1 with Text_IO; 

2 

3 procedure Hello_ada_ex is 

4 

5 — Function: 

6 — Write "Hello, world!" on a separate line to the 

7 — standard output, using Ada's "Text_IO" package. 

8 begin 

9 Text_IO.Put_line ("Hello, world!"); 
10 end Hello ada ex; 
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X-A.4.6 Hello os ex Procedure 



1 with Byte_Stream_AM, 

2 Device_Defs, 

3 Process_Mgt, 

4 Process_Mgt_Types, 

5 System; 
6 

7 procedure Hello_OS_ex is 

8 

9 — Function: 

10 — Write "Hello, world!" on a separate line to the 

11 — standard output, using OS packages. 
12 

13 hello: constant string := "Hello, world!" & ASCII. LF; 

14 stdout: constant Device_Defs.opened_device := 

15 Process_Mgt .Get_process_globals_entry ( 

1 6 Process_Mgt_Types . standard_output ) ; 

17 begin 

18 Byt e_Stream_AM. Ops. Write ( 

19 opened_dev => stdout, 

20 buffer_VA => hello (1) 'address, 

21 length => System. ordinal (hello' length) ) ; 

22 end Hello OS ex; 
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X-A.4.7 Join_File_Ex Package Specification 



1 with Join_Interface, 

2 System; 

3 package Join_File_Ex is 
4 

5 — Function: 

6 — This package provides examples using 

7 — the DBMS support operations. 
8 

9 — History: 

10 — 08-10-87, Paul Schwabe: initial revision. 

11 — 11-30-87, Paul Schwabe: update. 
12 

13 pragma external; 

14 

15 — Define some user buffer. 

16 

17 type stuff _buffer_type is 

18 array (1 .. 256) of character; 
19 

20 — Define local data structures. 
21 

22 type some_other_type is 

23 array (1 .. 256) of character; 
24 

25 type user_info_type is 

26 record 

27 first_call: boolean := true; 

28 — This is reset by the user join procedure 

29 — during the first call. 

30 comm_block: Join_Interface.communication_block_VA; 

31 — This is returned by the user join 

32 — procedure. 

33 user_specific: some_other_type; 

34 — Needed for the user's join algorithm. 

35 end record; 
36 

37 function Join_ex ( 

38 buf fers_available: System. ordinal; 

39 — Number of 4kbyte file buffers reserved 

40 — for this join. 

41 user_info: System. address; 

42 — Object for user process specific storage. 

43 records: Join_Interface.record_lists_AD) 

44 — The list of record locations for each 

45 — input device. Those are null the first time 

46 — this routine is called. 

47 return Join_Interface.communication_block_VA; 

48 — Contains the 'next block list' and the 

49 — output buffers. 

50 pragma subprogram_value (Join_Interface.Block_join, Join_ex) ; 
51 

52 — Function: 

53 — The function Join_ex (subprogram type 

54 — Join_Interface.Block_join) will be called 

55 — from inside the Join_Interf ace. Join. (After 

56 — having locked all the participating input 

57 — devices on file level, we call the Join) . 
58 

59 

60 procedure Join_call ( 

61 num_input_de vices: System. short_ordinal) ; 

62 — Number of participating devices. 

63 — Function: 

64 — Calls the Join procedure. 
65 

66 

67 end Join_File_Ex; 

68 

69 

70 
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X-A.4.8 Join_File_Ex Package Body 



1 with Device_Defs, 

2 Join_Interface, 

3 System, 

4 Unchecked_Conversion; 

5 package body Join_File_Ex is 
6 

7 — Logic: 

8 — This package body contains the implementations 

9 — for the examples using the DBMS support 
10 — operations. 

11 
12 

13 — 

14 ~ UNCHECKED CONVERSIONS 

15 — 
16 

17 function Convert_comm_block_VA_to_address is 

18 new Unchecked_Conversion { 

19 source => Join_Interface. 

20 communication_block_VA, 

21 target => System. address) ; 
22 

23 function Convert_address_to_comm_block_VA is 

24 new Unchecked_Conversion( 

25 source => System. address, 

26 target => Join_Interface. 

27 communication_block_VA) ; 
28 

29 function Convert_address_to_next_block_VA is 

30 new Unchecked_Conversion( 

31 source => System. address, 

32 target => Join_Interface. 

33 next_block_list_VA) ; 
34 

35 function Convert_next_block_VA_to_address is 

36 new Unchecked_Conversion ( 

37 source => Join_Interface. 

38 next_block_list_VA, 

39 target => System. address) ; 
40 

41 

42 

43 — BODY FOR THE SUBPROGRAM TYPE BLOCK_JOIN 

44 -> 

45 

46 function Join_ex ( 

47 buffers_available: System. ordinal; 

48 — Number of 4kbyte file buffers reserved 

49 — for this join. 

50 user_info: System. address; 

51 — Object for user specific storage. 

52 records: Join_Interface.record_lists_AD) 

53 — The list of record locations for each 

54 — input device. Those are null the first time 

55 — this routine is called. 

56 return Join_Interface.communication_block_VA 

57 — Contains the 'next block list' and the 

58 — output buffers. 
59 

60 — Operation: 
61 

62 is 

63 u_info: user_info_type; 

64 FOR u_info USE AT user_info; 

65 — Retypes the address to user_info_type. 
66 

67 comm_block: Join_Interface.communication_block; 

68 FOR comm_block USE AT 

69 Convert_comm_block_VA_to_address { 

70 u_info.comm_block) ; 

71 — Just a rename. 
72 

73 num_devices: System. short_ordinal := 

74 records. num devices; 
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75 — Number of input devices for this Join. 

76 

77 begin 

78 

79 — First distribute the 'buffers_available' among 

80 — the input devices in some manner. Make sure the 

81 — number of buffers requested at a time does not 

82 — exceed the numbers of buffers available. 
83 

84 — .... lets say 2 buckets per block per input 

85 — file is the result. 
86 

87 

88 if u_info.first_call then 

89 — This is the first time this function is 

90 — called. (This can also be recognized by 

91 — checking the ADs in 'records', which are null 

92 — at this time) . 
93 

94 for i in 1 . . num_devices loop 

95 — Set up the communication block to condition 

96 — Join for the next call. 
97 

98 comm_block. posit ion_blocks.next_blocks (i) . 

99 block_size :=» 2; 

100 — Two buckets per block. 
101 

102 comm_block.position_blocks.next_blocks (i) . 

103 position := JoinJEnterf ace. next; 

104 — We want to trace through the files from 

105 — the beginning to the end. The Join will 

106 — call this function the next time with 

107 — record locations of those records 

108 — contained in the first two buckets of the 

109 — input file i. "Current" would deliver 

110 — empty record location arrays at this 

111 — stage. "Previous" would start with the 

112 — last two buckets in the file. 
113 

114 end loop; 
115 

116 else 

117 — This is not the first call to this function. 
118 

119 — Here is where a join algorithm takes place. 
120 

121 — If i counts the devices from 1 . . 

122 — num_devices, and if j counts the number of 

123 — entries in one record_location_array (1 . . 

124 — num_records) , then the necessary data for the 

125 — join algorithm can be retrieved 

126 — via the following paths: 
127 

128 — num_records := records. rec_list_array (i) . 

129 — num_entries; 

130 — Number of records per record location array. 
131 

132 — One record can be found in: 
133 

134 — records. rec_list_array (i) .rec_loc_ar ray (j) . 

135 — record_VA 

136 — records. rec_list_array (i) . rec_loc_array < j) . 

137 — record_length 

138 — records. rec_list_array (i) .rec_loc_array (j) . 

139 _ — record_ID 
140 

141 — If the buckets scanned do not contain any 

142 — records then the "number_of_entries" will be 

143 — 0. It will be 

144 — "Join_Interface.null_num_entries" when the 

145 — end of the file has been exceeded. 
146 

147 — Now, join the records into the 

148 — 'buffer_with_stuff 

149 

150 — Set up the comm_block with respect to the 

151 — output buffers. 
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— comm_block.out_buffers.output_length := 

— some_value; 

— The length of the buffer contents 

— in bytes. A non zero value provides for 

— flushing the buffer to the output device. 

— Set up the communication block with 

— positioning information for the 

— subsequent call: 

— comm_block.position_blocks (i) .block_size := 2; 

— Two buckets per block. 

— comm_block.position_blocks (i) .position := 

Join_Interf ace . next ; 

— Makes the Join call this 

— function the next time with record locations 

— of those records contained in the next two 

— buckets of the input file i. 
null; 

end if; 

return u_info.comm_block; 

end Join ex; 



THE CALL 



The function Join_ex (subprogram type 
Join__Interf ace. Block_ join) will be called from 
inside the Join_Interf ace. Join. 

(After having locked all the participating input 
devices on file level, we call the Join) . 



procedure Join_call ( 

num_input_de vices : System. short_ordinal ) 
— Number of participating devices. 
— Operation: 

Calls the Join procedure. 



join_devices: Join_Interface. join_device_list ( 
num_input_de vices) ; 

— Input devices for the Join. 

out_f ile : Device_Def s . opened_device; 

— Output rec_lD_stream device. 

buffer_reservation: Join_Interface. < 

buffer_reservation_block; 

— Block which determines the number of buffers 

— needed. 

u_info: user_info_type; 

— Global storage for the Block_join procedure. 

— Will be passed to Block_join. 

comm_block: Join_Interface. communication_block; 

— Instantiates the communication block. 

— Contains the next_block list. 

buffer_with_stuff : stuff_buffer_type; 

— User records that will be copied to the output. 

length_of _one_stuf f _record : constant 
System. ordinal := 8; 

— Constant size of the "stuff records". 

— the output buffers; 

next blocks: Join Interface. next block list ( 
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229 num_entries «> num_input_de vices) ; 

230 — The list that specifies which blocks to use 

231 — for the next call. 
232 

233 begin 

234 

235 — Hook the comm_block into user info. 

236 

237 u_info.comm_block := 

238 Convert_address_to_comm_block_VA ( 

239 comm_block' address) ; 
240 

241 — • Initialize the comm_block. 
242 

243 comm_block.position_blocks := 

244 Convert_address_to_next_block_VA ( 

245 next_blocks' address) ; 

246 — Unchecked conversion; see Ada-G. 
247 

248 — Set up the communication block with respect to 

249 — the output buffers. 
250 

251 comm_block. out_buf fers . output_buf fer 

252 buffer_with_stuff address; 

253 comm_block. out_buf fers . record_size 

254 length_of_one_stuff_record; 

255 comm_block. out_buf f ers . alt_output_buf fer 

256 System. null_address; 

257 comm_block.out_buf fers.alt_record_size := 0; 
258 

259 — Here, the descriptors for the output buffers 

260 — have to be set to make sure the buffers don't 

261 — ■ get flushed, since they do not contain any 

262 — interesting data. 
263 

264 comm_block.out_buffers.output_length := 0; 

265 comm_block.out_buffers.alt_output_length : = 0; 
266 

267 — Get the ODOs for the input devices from somewhere. 

268 

269 — join_devices := {. . .); 

270 

271 — Calculate how much buffers should be reserved 

272 — by the Join at a time. Determine how many you 

273 — need as a minimum; what's the optimal number? 

274 — Do you want to wait until the buffers are 

275 — available? 
276 

277 — buffer_reservation := (...); 

278 

279 — Create and/or Open the output device 

280 

281 -- out_file := 

282 

283 — Initialize the user info. 

284 

285 — u_info := 

286 

287 — And off we go: 

288 

289 Join_Interf ace. Join ( 

290 participating_devices => join_devices, 

291 buffers_to_reserve => buffer_reservation, 

292 user_info => u_info' address, 

293 join_jprocedure => 

294 Join_ex' subprogram_value, 

295 join_output => out_file, 

296 alternate_output => System. null_word) ; 
297 

298 end Join_call; 

299 

300 

301 end Join_File_Ex; 

302 

303 

304 
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X-A.4.9 Record_Locking_Ex Package Specification 

1 with Device_Defs, 

2 System_Defs; 

3 package Record_Locking_Ex is 
4 

5 — Function: 

6 — This package contains the examples for 

7 — using the record locking in your 

8 — applications. 
9 

10 — History: 

11 — 01-07-88, Paul Schwabe: initial version. 
12 

13 pragma external; 
14 

15 procedure Level_3_update ( 

16 file_name: System_Defs.text) ; 
17 

18 — Function: 

19 — This example is designed to illustrate level 

20 — 3 consistency. It reads the employee records 

21 — in a key range and updates the salaries. 
22 

23 — Does an index-sequential read of an 

24 — unordered file using a single b-tree alternate 

25 — index. The read call uses a "write" lock mode 

26 — because the record will be updated after the read. 
27 

28 

29 end Record_Locking_Ex; 

30 
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X-A.4,10 Record_Locking_Ex Package Body 



1 with Device_Defs, 

2 Employee_Filing_Ex, 

3 File_Admin, 

4 File_Defs, 

5 Record_AM, 

6 System, 

7 System_Defs, 

8 Text_Mgt, 

9 Transact ion_Mgty 
10 

11 use System; 

12 

13 package body Record_Locking_Ex is 

14 

15 — Logic: 

16 — This package body contains the 

17 — the implementations for the record 

18 — locking examples. 
19 

20 buffer: stringd .. integer( 

21 Employee_Filing_Ex.max_rec_size) ) ; 

22 — Buffer is large enough to hold any employee 

23 — record. 
24 

25 current_record_addr: constant 

26 System. address := buffer' address; 

27 current_record_VA: constant 

28 Employee_Filing_Ex.employee_record_VA := 

2 9 Employee_Filing_Ex . Employee_record_VA_f rom_VA ( 

30 current_record_addr) ; 

31 

32 bytes_read: System. ordinal; 

33 — Number of bytes in current record. 
34 

35 

36 procedure Level_3_update ( 

37 file_name: System_Defs.text) 

38 — An opened device for transaction Tl, opened 

39 — for input on an employee file. 
40 

41 — ■ Operation: 

42 — Reads all records in a relative file and 

43 — totals the salaries. 
44 

45 — Does an index- sequential read of an 

46 — unordered file using a single b-tree alternate 

47 — index. Transaction Tl (a reader) reads 

48 — employee records using the write_lock lock 

49 — mode, locking the file from other readers and 

50 — writers. 
51 

52 is 

53 opened_file: Device_Defs.opened_device; 
54 

55 total_salary: Employee_Filing_Ex.monthly_salary 

56 := 0.00; 
57 

58 start_key_value: constant Employee_Filing_Ex. 

59 dept_salary_key_buf fer := { 

60 dept => 100, 

61 — Lowest department, ascending. 

62 salary => 10_000.00); 

63 — -Highest salary, descending. 
64 

65 stop_key_value: constant Employee_Filing_Ex. 

66 dept_salary_key_buffer := { 

67 dept => 500, 

68 — Highest department, ascending. 

69 salary => 1_000.00); 

70 — Lowest salary, descending. 
71 

72 level_3_mode : Record_AM. open_mode_value {Record_AM. level_3) 

73 (mode_id => Record_AM.level_3, 

74 value => true) ; 
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75 

76 begin 

77 Transaction_Mgt . Start_transaction; 

78 — Started on behalf of transaction Tl r 

79 — the level 3 reader. 

80 — Any updates, deletes or inserts 

81 — (not shown) within this transaction 

82 — can be rolled back if 

83 — the transaction aborts. 
84 

85 opened_file := Record_AM.Open_by_name ( 

86 name => file_name, 

87 input_output => Device_Defs.inout, 

88 allow =■> Device_Def s. anything) ; 
89 

90 Record_AM . Ops . Set_open_mode ( 

91 opened_dev => opened_file, 

92 mode_value => level_3_mode) ; 

93 — Sets level 3 consistency. 
94 

95 Record_AM . Keyed_Ops . Set_key_range ( 

96 opened_file, 

97 index => Employee_Filing_Ex. 

98 dept_salary_index_name, 

99 select_range =*> ( 

100 start_comparison => 

101 Record_AM. inclusive, 

102 start_value => { 

103 start_key_yalue' address, 

104 start_key_value' size / 8) , 

105 stop_comparison => 

106 Record_AM. inclusive, 

107 stop_value => ( 

108 stop_key_value' address, 

109 stop_key_value'size / 8))); 
110 

111 loop 

112 bytes_read := Record_AM. Ops. Read < 

113 opened_dev => opened_file, 

114 buffer_VA => current_record_addr, 

115 length => Employee_Filing_Ex. 

116 max_rec_size, 

117 lock => Record_AM.write_lock, 

118 unlock => Record_AM.no_unlock) ; 

119 — Another caller cannot read or update 

120 — the same record at any time. 
121 

122 if cur rent_record_VA. salary = 3_000.00 then 

123 current_record_VA. salary : = 

124 current_record_VA. salary + 300.00; 
125 

126 Record_AM. Ops. Update ( 

127 opened_dev => opened_file, 

128 modifier => Record_AM. current, 

129 buffer_VA => current_record_addr, 

130 length => Employee_Filing_Ex. 

131 max_rec_size, 

132 timeout => Record_AM.wait_forever, 

133 status => null); 

134 end if; 

135 end loop; 
136 

137 exception 

138 when Device_Defs.end_of_file => 

139 Transact ion_Mgt .Commit_transaction; 

140 — Everthing's OK. 
141 

142 when others => 

143 — Something's bad. 

144 null; 

145 end Level_3_update; 
146 

147 end Record Locking Ex; 
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X-A.4.1 1 Output __bytes__ex Procedure 



1 with Byte_Stream_AM, 

2 Device_Defs, 

3 Process_Mgt, 

4 Process_Mgt_Types, 

5 System, 

6 System__Defs, 

7 Unchecked_conversion; 
8 

9 procedure Output_bytes_ex ( 

10 name: System_Defs.text) 

11 — Input device to read. 
12 

13 — Function: 

14 — Opens the named input device and 

15 — copies bytes from it to the caller' s 

16 — standard output, until end-of-file. 

17 is 

18 source_opened_device: Device_Defs.opened_device; 

19 dest_opened_davices D@vice_Defs=opened_device; 

20 function Opened_device_from_untyped is new 

21 Unchecked_conversion ( 

22 source -> System. untyped_word, 

23 target => Device_Defs.opened_device) ; 

24 BUFSIZE: constant System. ordinal := 4_096; 

25 buffer: array (1 .. BUFSIZE) of 

26 System. byte_ordinal; 

27 bytes_read: System. ordinal; 

28 begin 

29 source_opened_device := 

3 By t e_St re am_AM . Open_by_name ( 

31 name => name, 

32 input_output => Device_Defs. input, 

33 allow => Device_Defs. readers) ; 

34 dest_opened_device := Opened_device_from_untyped( 

35 Process_Mgt .Get_process_globals_entry ( 

36 Process_Mgt_Types.standard_output) ) ; 
37 

38 loop 

39 bytes_read := Byte_Stream_AM.Ops.Read( 

40 source_opened_device, 

41 buffer' address, 

42 BUFSIZE) ; 

43 Byte_Stream_AM.Ops.Write( 

44 dest_opened_device, 

45 buffer' address, 

46 bytes_read) ; 

47 end loop; 

48 exception 

49 when Device_Defs.end_of_file => 

50 Byte_Stream_AM. Ops. Close ( 

51 source_opened_device) ; 

52 end Output bytes ex; 
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X-A.4.12 Output_records_ex Procedure 



1 with Device_Defs, 

2 Object_Mgt, 

3 Process_Mgt, 

4 Process_Mgt_Types, 

5 Record_AM, 

6 System, 

7 System_Defs, 

8 Unchecked_conversion; 
9 

10 procedure Output_records_ex ( 

11 name: System_Defs.text) 

12 — Pathname of device. Caller must have 

13 — read rights. 
14 

15 — Operation: 

16 — Opens a named device, reads a stream 

17 — of records, and writes the records to 

18 — the caller's standard output, until 

19 — end-of-file. 
20 

21 — Notes: 

22 — The record buffer is dynamically sized 

23 — so that records of any length can be 

24 — handled. Recovery from buffer overflow 

25 — uses the "rest_of_current" rather than 

26 — "current" read option, because some 

27 — devices, such as pipes, do not support 

28 — the "current" option. 
29 

30 — Exceptions: 

31 — Device_Defs.device_in_use - 

32 — The device is being used by 

33 — an application that does not 

34 — allow concurrent readers. 

35 — Device_Defs.open_mode_conflict - 

36 — The named object does not 

37 — allow opens for input. 

38 — Device_Defs.device_inconsistent 

39 — Device_Defs.device_offline 

40 — Device_Defs.device_inoperative 

41 — Device_Defs.transfer_error 

42 — Directory_Mgt.no_access - 

43 — There is no such pathname 

44 — or the caller does not have 

45 — access to the named device. 

46 — Directory_Mgt.name_too_long - 

47 — The pathname or some part of it 

48 — exceeds an OS size limit. 

49 — File_Defs.volume_space_exhausted 

50 — Record_AM.XXX - 

51 — Many "Record_AM" exceptions 

52 — can be raised. See "Read" and 

53 — "Insert" in "Record_AM.Ops" . 

54 is 

55 use System; — Import ordinal operators. 

56 source_opened_device: Device_Defs.opened_device; 

57 dest_opened_device: Device_Defs.opened_device; 

58 buffer_size: System. ordinal := 256; 

59 buffer_AD: System. untyped_word := 

60 Ob ject_Mgt. Allocate (buffer_size/4) ; 

61 — 64 words (256 bytes) is the initial buffer 

62 — size. Buffer size is increased as needed. 

63 — The buffer is in a separate object for easy 

64 — resizing. 

65 bytes_read: System. ordinal := 0; 

66 — If record requires multiple "Read" calls, 

67 — then this variable tracks bytes read so far. 

68 read_status_VA: Record_AM.operation_status_VA := 

69 new Record_AM.operation_status_record; 

70 read_position: Record_AM.position_modifier := 

71 Record_AM.next; 

72 — If record requires multiple "Read" calls, 

73 — then this variable is assigned 

74 — "Record AM. rest of current" for the 
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75 — 2nd through Nth reads. 

76 function Opened_device_from_untyped is new 

77 Unchecked_conversion( 

78 source => System. untyped_word, 

79 target => Device_Defs.opened_device) ; 

80 begin 

81 source_opened_device := Record_AM.Open_by_name ( 

82 name -> name, 

83 input_output => Device_Defs. input, 

84 allow => Device_Defs. readers) ; 

85 dest_opened_device := Opened_device_f rom_untyped ( 

86 Process_Mgt .Get_process_globals_entry ( 

87 Process_Mgt_Types.standard_output) ) ; 
88 

89 loop 
90 

91 loop 

92 begin 

93 bytes_read := bytes_read + 

94 Record_AM.Ops.Read( 

95 source_opened_device, 

96 r@ad_position, 

97 System. address' ( 

98 bytes_read, 

99 buf fer_AD) , 

100 buffer_size - bytes_read, 

101 status => read_status_VA) ; 
102 

103 — When control reaches this point, "Read" 

104 — succeeded without a length error and 

105 — this loop can be exited. 

106 EXIT; 
107 

108 exception 

109 when Device_Defs.length_error => 

110 buffer_size := read_status_VA.rec_length; 

111 if buffer_size = 

112 Record_AM.unknown_length then 

113 buffer_size := 2 * 4 * 

114 Object_Mgt.Get_object_size (buffer_AD) 

115 — Double the buffer size if an exact 

116 — new size is not available. 

117 end if; 

118 Ob ject_Mgt. Resize ( 

119 buffer_AD, 

120 (buffer_size+3) /4) ; 

121 — May make object even bigger than 

122 — requested, but that's OK. 

123 readjposition := Record_AM.rest_of_current; 

124 end; 

125 end loop; 
126 

127 Record_AM. Ops. Insert ( 

128 dest__opened_device, 

129 System. address' (0, buf fer_AD) , 

130 bytes_read) ; 
131 

132 — Reset variables to read the next record 

133 — into the beginning of the buffer: 
134 

135 bytes_read := 0; 

136 read_position := Record_AM.next; 

137 end loop; 
138 

139 exception 

140 when Device_Defs.end_of_file => 

141 Record_AM. Ops. Close (source_opened_device) ; 

142 end Output_records_ex; 
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X-A.4.13Print cmd ex Procedure 



1 with Byte_Stream_AM, 

2 CL_Defs f 

3 Command_Handler, 

4 Device_Defs, 

5 Directory_Mgt, 

6 Print_Cmd_Messages, — Message package. 

7 Incident_Defs, 

8 Message_Services, 

9 Process_Mgt, 

10 Process_Mgt_Types, 

11 Spool_Defs, 

12 Spool_Device_Mgt, 

13 String_List_Mgt, 

14 System, 

15 System_Defs, 

16 Text_Mgt; 
17 

18 procedure Print_cmd_ex 
19 

20 — Function: 

21 — Defines a command to print from a file or other 

22 — byte stream source 
23 

24 — Command Definition: 

25 — The command has the form: 
26 

27 — print 

28 — [source=<pathname>] 

29 — [on=<pathname>] 
30 

31 — The on argument can either be a spool queue or a 

32 — printer (for direct printing) . The default is a 

33 — system standard spooling device. The source 

34 — argument will default to standard input. 
35 

36 — *C* set.message_file :file = \ 

37 — *C* /examples/msg/example_messages 

38 — *c* 

39 — *C* create . command :cmd_def = print . inv_cmd \ 

40 — *C* :cmd_name = print 

41 — *c* 

42 — *C* define. argument source 

43 — *C* :type = string 

44 — *C* set.lexical_class symbolic_name 

45 — *C* set.maximum_length 252 

46 — *C* set.value_default "" 

47 — *c* end 

48 — *C* 

49 — *C* define. argument on 

50 — *c* :type = string 

51 — *C* set ,lexical_class symbolic_name 

52 — *C* set.maximum_length 80 

53 — * c * set.value_default "" 

54 — *c* end 

55 — * c * end 

56 — *C* 

57 — *C* run "store. command_definitions \ 

58 — *C* iprogram = print \ 

59 — *C* :invocation_cmd = print . inv_cmd" 

60 — *C* 

61 — *C* run "store. default_message_file \ 

62 — *c* print \ 

63 — *C* print. msg" 
64 

65 is 

66 

67 use System; 

68 

69 

70 opened_cmd: Device_Defs.opened_device; 

71 — Opened command input device. 
72 

73 — source variables 

74 source: System_Def s. text (252) ; 
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75 — Pathname of file or device 

76 — print from 
77 

78 open_source: Device_Defs.opened_device; 

79 

30 — "on" variables 

81 on_device : System_Def s . text (Incident_Def s . txt_length) ; 

82 — Pathname of spool queue or 

83 — printer 
84 

85 on_untyped: System. untyped_word; 

86 

87 spool_queue: Device_Defs. device; 

88 

89 print_device: Devi ce_Defs.de vice; 

90 

91 no_print_device: exception; 

92 

93 sheet_size: constant Spool_Defs.size_t :== 

94 (132,66); 
95 

96 openjprint: Device_Defs.opened_device; 

97 

98 — buffer variables 

99 buffer_size: constant System. ordinal := 4_096; 

100 buffer: array (1. .buffer_size) of 

101 System. byte_ordinal; 

102 bytes_read: System. ordinal; 
103 

104 begin 

105 

106 — Get command arguments: 

107 

108 opened_cmd := 

109 Comma'nd_Handler. 

110 Open_invocation_command_processing; 

111 Command_Handler.Get_string(opened_cmd, 1, 

112 arg_value => source); 

113 Command_Handler.Get_string (opened_cmd, 2, 

114 arg_value => on_device) ; 

115 Command_Handler. Close (opened_cmd) ; 
116 

117 — assign defaults if parameter was not specified 
118 

119 if source. length = then 

120 open_source := 

121 Process_Mgt .Get_process_globals_entry ( 

122 Process_Mgt_Types . standard_input ) ; 

123 — standard input from terminal 

124 else 

125 open_source := Byte_Stream_AM.Open_by_name ( 

126 name => source, 

127 input_output => Device_Defs. input) ; 

128 end if; 
129 

130 if on_device. length = then 

131 Text_Mgt . Set (on_device, "/dev/lpq") ; 

132 — Correct name of default system spool queue is 

133 — TBD 

134 end if; 
135 

136 — check the "on_device" for spooled or direct 

137 — printing, else error 
138 

139 on_untyped := Directory _Mgt .Retrieve (on_device) ; 

140 if Spool_Defs.Is_spool_queue (on_untyped) then 

141 print_device := 

142 Spool_Device_Mgt . Create_print_device ( 

143 spool_queue => spool_queue, 

144 pixel_units => false, 

145 print_area => sheet_size); 
146 

147 elsif Spool_Defs.Is_print_device (on_untyped) then 

148 print_device := 

149 Spool_Device_Mgt.Create_print_device ( 

150 spool_queue => spool_queue, 

151 pixel units => false, 
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152 print_area => sheet_size, 

153 print_mode => Spool_Defs.page_wlse) ; 

154 — direct printing 
155 

156 else 

157 RAISE no_j?rint_device; 

158 end if; 
159 

160 open_print := Byte_stream_AM.Ops.Open( 

161 print_device, 

162 Device_Defs. output) ; 
163 

164 while not 

165 Byte_Stream_AM.Ops.At_end_of_file(open_source) 

166 loop 

167 bytes_read := Byte_Stream_AM.Ops.Read( 

168 opened_dev => open_source, 

169 buffer_VA => buffer' address, 

170 length => buf fer_size) ; 
171 

172 Byte_Stream_AM. Ops. Write ( 

173 opened_dev => open_print, 

174 buffer_VA => buffer' address, 

175 length => bytes_read) ; 

176 end loop; 
177 

178 Byte_Stream_AM. Ops. Close (open_source) ; 

179 Byte_Stream_AM. Ops. Close (open_print) ; 
180 

181 exception 

182 when no_print_device => 

183 Message_Services.Write_msg( 

184 Print_Cmd_Messages.no_print_device_code, 

185 Incident_Def s.message_parameter ( 

186 typ => Incident_Defs.txt, 

187 len => on_device.max_length) ' ( 

188 typ => Incident_Defs.txt, 

189 len => on_device.max_length, 

190 txt_val => on_device)); 
191 

192 when Spool_Device_Mgt.units_not_supported => 

193 Message_Services.Write_msg( 

194 Print_Cmd_Messages 

195 .units_not_supported_code, 

196 Incident_Def s . message_parameter ( 

197 typ => Incident_Defs.txt, 

198 len => on_device.max_length) ' ( 

199 typ => Incident_Defs.txt, 

200 len => on_device.max_length, 

201 txt_val => on_device)); 

202 end Print_cmd_ex; 
203 
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X-A.4.14Print_Cmd_Messages Package 



1 with Incident_Defs, 

2 System, 

3 System_Defs; 
4 

5 package Print_Cmd_Messages is 
6 

7 — Function: 

8 — Define messages used by Print_cmd_ex 

9 — All messages defined use a module ID of 0. 
10 

11 print_msg_j>athname : constant System_Def s.text_AD := 

12 new System_Defs.text' ( 

13 32, 32, "/examples/msg/print_cmd_messages") ; 

14 — AD to pathname of message file, bound to 

15 — "msg_obj", following. 

16 — *This will go away when "pragma bind" changes.* 
17 

18 msg_obj: constant System. untyped_word : = 

19 System. null word; 

20 pragma bind(msg_obj, 

21 "example_messages.print_msg_pathname") ; 

22 — Message object for incident codes in 

23 — example programs, bound to above 

24 — "message_file_pathname". 
25 

26 — *When the resident compiler and linker are* 

27 — *ready, this pragma will become:* 

28 — | pragma bind(msg_obj, 

29 — | "/examples/msg/print_cmd_messages") ; 
30 

31 

32 no_print_device_code: 

33 constant Incident_Defs.incident_code := 

34 (0, 1, Incident_Defs. information, msg_obj); 
35 

36 — *M* store :module=0 :number=l \ 

37 — *M* :msg_name=name_space_created_code \ 

38 — *m* : short = \ 

39 — *M* "Print Device $pl<on> does not exist." 
40 

41 units_not_supported_code: 

42 constant Incident_Defs.incident_code := 

43 (0, 2, Incident_Defs. information, msg obj); 
44 

45 — *M* store :module=0 :number=2 \ 

46 — *M* :msg_name=units_not_supported_code \ 

47 __* M * : short = \ 

48 — *M* "Unit $pl<on> not supported." 
49 

50 end Print Cmd Messages; 
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X-A.4.15 Record_AMjEx Package Specification 



1 with DeviceJDefs, 

2 Employee_Filing_Ex, 

3 Record_AM, 

4 System, 

5 System_Defs; 
6 

7 package Record_AM_Ex is 

8 

9 — Function: 

10 — This package contains the example subprograms 

11 — for using the Record_AM package. 
12 

13 — History: 

14 — 08-10-87, Paul Schwabe: initial version. 

15 — 11-23-87, Paul Schwabe: revision. 
16 

17 pragma external; 
18 

19 function Get_record_ID ( 

20 opened_file: Device_Defs.opened_device) 

21 — An opened device, opened for input on an 

22 — employee file. 

23 return Record_AM.record_ID; 
24 

25 — Operation: 

26 — Returns a record ID from the operation status 

27 — information. The record ID can be used in 

28 — subsequent retrieval operations to maximize 

29 — access time to the specified record. 
30 

31 

32 function Get_record_number ( 

33 opened_file: Device_Defs.opened_device) 

34 — An opened device, opened for input on an 

35 — employee file. 

36 return System. ordinal; 
37 

38 — Operation: 

39 — Returns a record number from the operation 

40 — status information. The record number can be 

41 — used in subsequent retrieval operations for 

42 — relative files. 
43 

44 

45 procedure Insert_record( 

46 opened_file: Device_Defs.opened_device) ; 

47 — An opened device, opened for input on an 

48 — employee file. 
49 

50 — Function: 

51 — Inserts a record into a structured file. 
52 

53 — Applicable for any file organization. 

54 — Position of the inserted record in the file 

55 — is determined by the system. The new record 

56 is automatically assigned a record ID. 
57 

58 

5 9 procedure Read_random_by_record_ID ( 

60 opened_file: Device_Def s.opened_device; 

61 rec_id: Record_AM.record_ID); 

62 — An opened device, opened for input on an 

63 — employee file. 
64 

65 — Function: 

66 — Reads a record randomly using a previously 

67 — retrieved record ID from the operation status 

68 — information. This is the fastest possible 

69 — random access to a record using any 

70 — structured file organization. 
71 

72 

73 procedure Read_random_by_record_number ( 

74 opened_file: Device_Defs.opened_device; 
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75 rec_number: System. ordinal ) ; 

76 — An opened device, opened for input on an 

77 — employee file. 
78 

79 — Function: , 

80 — Reads a record randomly from a relative file [ 

81 — using a previously retrieved record ID from 

82 — the operation status information. Record 

83 — numbers are only applicable for relative 

84 — files. 
85 

86 
87 

88 procedure Read_next_simple_index ( 

89 opened_file: Devi ce_Defs.opened_de vice) ; 

90 — An opened device, opened for input on an employee 

91 — file. 
92 

93 — Function: 

94 — Reads a range of records in the "Dept" index. 
95 

96 — Positions to the beginning of the range and 

97 — reads successive records until the end. The 

98 — start value is to the left of the index. 

99 — This composite index is read by ascending key 

100 — values starting at the lowest key value in 

101 — the range. 
102 

103 — Dept (asc) A B ... X Y 

104 — > EOF 

105 — The posit ion_modifier value is Record_AM.next 
106 

107 — Notes: 

108 — This function replaces any previous key range 

109 — and changes the file's record pointer. 
110 

111 — The "Dept" index is ascending on department. 

112 — Returns all employee records for the 

113 — departments in the specified range. 
114 

115 ,'' 

116 ^ 
117 

118 procedure Read_jprior_simple_index{ 

119 opened_file: Device_Defs.opened_device) ; 

120 — An opened device, opened for input on an 

121 — employee file. 
122 

123 — Function: 

124 — Reads a range of records in the "Dept" index. 
125 

126 — Positions to the end of the range and reads 

127 — successive records until the beginning. The 

128 — start value is to the right of the index. 

129 — This composite index is read by ascending key 

130 — values starting at the lowest key value in 

131 — the range. 
132 

133 — Dept (asc) A B ... X Y 

134 — EOF < 

135 — The position_modifier value is 

136 — Record_AM. prior 
137 

138 — Notes: 

139 — This function replaces any previous key range 

140 — and changes the file's record pointer. 
141 

142 — The "Dept" index is ascending on department. 

143 — Returns all employee records for the 

144 — departments in the specified range. 
145 

146 
147 
148 

149 procedure Read_duplicates ( 

150 opened_file: Device_Defs.opened_device) ; (. 

151 — An opened device, opened for input on an 'i 
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152 
153 
154 
155 
156 
157 
158 
159 
160 
161 
162 
163 
164 
165 
166 
167 
168 
169 
170 
171 
172 
173 
174 
175 
176 
177 
178 
179 
180 
181 
182 
183 
184 
185 
186 
187 
188 
189 
190 
191 
192 
193 
194 
195 
196 
197 
198 
199 
200 
201 
202 
203 
204 
205 
206 
207 
208 
209 
210 
211 
212 
213 
214 
215 
216 
217 
218 
219 
220 
221 
222 
223 
224 
225 
226 
227 
228 



employee file. 

Function: 

Reads a duplicate records in the specified 
"Dept" index. 

Positions to the specified record and reads 
all duplicates until the end. 

Dept (asc) A A ... A A 

> EOF 

The position_modifier value is Record_AM.next 

Notes: 

This function replaces any previous key range 
and changes the file's record pointer. 

The "Dept" index is ascending on department. 
Returns all employee records for the 
departments in the specified range. 

The range contains employees in "Accounting™ 
through "Marketing". 

If the "Dept" index were specified as 
non-unique, returns duplicate recores for a 
. particular "Dept" key value. For example, 
one record might contain fields on 
management, cost control, and history. A 
second record might simply hold text. 



procedure Delete_records_sequential ( 

opened_f ile : Device_Def s . opened_device) ; 

An opened device, opened for input on an 
employee file. 

— Function: 

Deletes a range of records using the 
department name as a key. This example shows 
that a Read or Set_position is not required 
to preface each Delete. The current record 
pointer advances after each Delete. 

procedure Read_and_update_by_key { 

opened_file: Device_Defs.opened_device) ; 

An opened device, opened for input on an 
employee file. 

— Function: 

Updates a record within a range of records. 
This example shows that the current record 
pointer does NOT advance after the 
Update_by_key . 



procedure Read_records_reverse_sequential ( 

opened_file: Device_Defs.opened_device) ; 

An opened device, opened for input on an 
employee file. 

— Function: 

Reads all records in a reverse sequence. 
Shows Shows physical-sequential access. 

Positions to the end of the sequence and 
reads successive records until the beginning. 

— After each read, the current record pointer 
is positioned to the prior record. 



procedure Read_records_sequential ( 

opened_file: Device_Defs.opened_device) ; 

An opened device, opened for input on an 
employee file. 
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229 

230 — Function: 

231 — Reads all records in a sequence. Shows 

232 — physical-sequential access. 
233 

234 — Positions to the start of the sequence and 

235 — reads successive records until the end. 
236 

237 — Notes: 

238 — Advances the file' s current record pointer 

239 — forward after each read. 
240 

241 
242 

243 procedure Read_and_delete_records ( 

244 opened_file: Device_Defs.opened_devlce) ; 

245 — An opened device, opened for input on an 

246 — employee file. 
247 

248 — Function: 

249 — Reads and deletes selected records in a 

250 — sequence. 
251 

252 — Positions to the beginning of the sequence 

253 — and reads successive records until the end. 

254 — After each read, a record is checked and then 

255 — deleted if it satisfies the specified 

256 — conditions. The current record pointer is 

257 — positioned to the next record after the 

258 — deleted record. 
259 

260 

261 procedure Read_and_update_records ( 

262 opened_file: Device_Defs.opened_device) ; 

263 — An opened device, opened for input on an 

264 — employee file. 
265 

266 — Function: 

267 — Reads and updates records in a sequence. 
268 

269 — Positions to the beginning of the sequence 

270 — and reads successive records until the end. 

271 — After each read, the current record pointer 

272 — is positioned to the next record. 
273 

274 

275 procedure Update_salary_example { 

276 T2_opened_file: Device_Def s.opened_device) ; 

277 — An opened device for transaction Tl, 

278 — opened for input on an employee file. 
279 

280 — Function: 

281 — Does an index-random update of a record in an 

282 — indexed relative file. 
283 

284 — The Update_salary_example procedure starts 

285 — transaction T2 to double an employee's 

286 — salary. If transaction T2 aborts, then the 

287 — update is rolled back. 
288 

289 — Notes: 

290 — The example relative file is created with the 

291 — following parameters: 

292 — xm_locking -> true 

293 — short_term_logging => true 

294 — The example index (with a key built on 

295 — "employee ID") is built with 

296 — phantom protected => false. 



297 
298 

299 end Record_AM_Ex; 
300 
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X-A.4.16 Record_AM_Ex Package Body 



1 with Device_Defs, 

2 Employee_Filing_Ex, 

3 File_Admin, 

4 File_Defs, 

5 Record_AM, 

6 System, 

7 System_Defs, 

8 Transact ion_Mgt; 
9 

10 — For Importing operations. 

11 use Employee_Filing_Ex, 

12 System, 

13 SystemJDefs; 
14 

15 package body Record_AM_Ex is 
16 

17 — Logic: 

18 — Provides the implementation code for the 

19 — Record_AM examples. 
20 

21 

22 

23 — CONSTANT AND VARIABLE DECLARATIONS 

24 

25 

26 buffer: string(l .. integer (Employee_Filing_EX.max_rec_size) ) 

27 — Buffer is large enough to hold any employee 

28 — record. 
29 

30 current_record_addr: constant System. address := 

31 buffer' address; 

32 current_record_VA: constant Employee_Filing_EX. 

33 employee_record_VA := Employee_Filing_EX. 
3 4 Empl oyee_record_VA_f rom_VA ( 

35 current_record_addr) ; 

36 

37 pay_raise: constant float := 2.0; 

38 

39 bytes_read: System. ordinal; 

40 — Number of bytes in current record. 
41 

42 read_status_VA: Record_AM.operation_status_VA := 

43 new Record_AM.operation_status_record; 

44 — Virtual address of status record. 
45 

46 — Employee name constant. 

47 employee: constant Employee_Filing_EX.person_name := 

48 (Employee_Filing_EX.max_text_length, 

49 10, 

50 "Einstein, Albert "); 
51 

52 

53 — SUBPROGRAM DECLARATIONS 

54 

55 

56 function Get_record_ID ( 

57 opened_file: Device_Defs. ope ned_de vice) 

58 — An opened device, opened for input on an 

59 — employee file. 

60 return Record_AM.record_ID 

61 — Note: 

62 — Records in any structured file can have 

63 — record IDs, but only records in relative 

64 — files can have record numbers! 

65 is 

66 begin 

67 Record_AM.Ops.Set_position( 

68 opened_dev => opened_file, 

69 where => Record_AM.record_specifier ( 

70 type_of_specifier => Record_AM. first) ' ( 

71 type_of_specifier => Record_AM. first) ) ; 

72 loop 

73 bytes_read := Record_AM. Ops. Read ( 

74 opened dev => opened file, 
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75 buffer_VA => buffer' address, 

76 length => buffer' length, 

77 status => read_status_VA) ; 

78 if current_record_VA.name = employee then 

79 RETURN read_status_VA.rec_ID; 
80 

81 end if; 

82 end loop; 
83 

84 exception 

85 when Device_Defs.end_of_file => 

86 RETURN Record_AM.null_record_ID; 
87 

88 end Get_record_ID; 

89 

90 

91 function Get_record_number ( 

92 opened_file: Device_Defs.opened_device) 

93 — An opened device, opened for input on an 

94 — employee file. 

95 return System. ordinal 
96 

97 is 

98 begin 

99 Record_AM.Ops.Set_jposition( 

100 opened_dev => opened_file, 

101 where => Record_AM.record_specifier ( 

102 type_of_specifier => Record_AM. first) ' ( 

103 type_of_specifier => Record_AM. first) ) 

104 loop 

105 bytes_read := Record_AM. Ops. Read ( 

106 opened_dev => opened_file, 

107 buffer_VA => buffer' address, 

108 length => buffer' length, 

109 status => read_status_VA) ; 

110 if current_record_VA.name = employee then 

111 RETURN read_status_VA.rec_num; 
112 

113 end if; 

114 end loop; 
115 

116 exception 

117 when Device_Defs.end_of_file => 

118 RETURN 0; 
119 

120 end Get_record_number; 

121 

122 

123 

124 procedure Insert_record( 

125 opened_file: Device_Defs.opened_device) 

126 — An opened device, opened for input on an 

127 — employee file. 
128 

129 is 

130 begin 

131 — Obtain the new record from 

132 — somewhere (form or file) 

133 — and load the record buffer. 
134 

135 Record_AM.Ops. Insert ( 

136 opened_dev => opened_file, 

137 buffer_VA => buffer' address, 

138 length => System. ordinal ( 

139 Employee_Filing_EX.max_rec_size) ) ; 
140 

141 end Insert_record; 

142 

143 

144 procedure Read_random_by_record_ID ( 

145 opened_file: Device_Defs.opened_device; 

146 rec_ID: Record_AM.record_ID) 

147 — An opened device, opened for input on an 

148 — employee file. 

149 is 

150 begin 

151 Record_AM.Ops.Set_position ( 
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152 opened_file, 

153 where => Record_AM.record_specifier ( 

154 type_of_specifier => Record_AM.id) ' { 

155 type_of_specifier => Record_AM.id, 

156 rec_id => rec_ID) ) ; 
157 

158 bytes_read := Record_AM. Ops. Read ( 

159 opened_dev => opened_file, 

160 buffer_VA => buffer' address, 

161 length => buffer' length) ; 
162 

163 end Read_random_by_record_ID; 

164 

165 

166 procedure Read_random_by_record_number ( 

167 opened_file: Devi ce_Defs.opened_de vice; 

168 rec_number: System. ordinal) 

169 — An opened device, opened for input on an 

170 — employee file. 

171 is 

172 begin 

173 Record_AM.Ops.Set_position ( 

174 opened_file, 

175 where => Record_AM.record_specifier ( 

176 type_of_specifier => Record_AM. number) ' ( 

177 type_of_specifier => Record_AM. number, 

178 rec_num => rec_number) ) ; 

179 bytes_read := Record_AM. Ops. Read ( 

180 opened_dev => opened_file, 

181 buffer_VA => buffer' address, 

182 length => buffer' length) ; 
183 

184 end Read_random_by_record_number; 

185 

186 

187 procedure Read_next_simple_index ( 

188 opened_file: Device_Defs.opened_device) 

189 — An opened device, opened for input on an 

190 — employee file. 
191 

192 is 

193 start_key_value: constant Employee_Filing_EX. 

194 dept_key_buffer := (dept => 100); 

195 — Lowest deptartment for 

196 — ascending key field. 
197 

198 start_key_descr: constant 

199 Record_AM.key_value_descr := { 

200 start_key_value' address, 

201 start_key_value' size / 8) ; 
202 

203 stop_key_value: constant Employee_Filing_EX. 

204 dept_key_buffer := (dept => 500); 

205 — High end for ascending key field. 
206 

207 stop_key_descr: constant 

208 Record_AM.key_value_descr := ( 

209 stop_key_value' address, 

210 stop_key_value' size / 8) ; 

211 begin 

212 Record_AM . Keyed_Ops . Set_key_range ( 

213 opened_dev => opened_file, 

214 index => 

215 Employee_Filing_EX.dept_index_name, 

216 select_range => ( 

217 start_comparison => Record_AM. exclusive, 

218 start_value => start_key_descr, 

219 stop_comparison => Record_AM. inclusive, 

220 stop_value => stop_key_descr) ) ; 
221 

222 loop 

223 bytes_read := Record_AM. Ops. Read ( 

224 opened_dev => opened_file, 

225 modifier => Record_AM.next, 

226 — Next is normally defaulted. 

227 buffer_VA => buffer' address, 

228 length => buffer' length) ; 
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229 

230 — DO ANY NEEDED PROCESSING HERE. 

231 

232 end loop; 

233 

234 exception 

235 when Device_Defs.end_of_file => 

236 null; 

237 end Read_next_simple_index; 
238 

239 

240 procedure Read_prior_simple_index( 

241 opened_file: Device_Defs.opened_device) 

242 — An opened device, opened for input on an 

243 — employee file. 
244 

245 is 

246 start_key_value: constant Employee_Filing_EX. 

247 dept_key_buffer := (dept => 500); 

248 — High end for ascending key field. 
249 

250 start_key_descr: constant 

251 Record_AM.key_value_descr := ( 

252 start_key_value' address, 

253 start_key_value' size / 8); 
254 

255 stop_key_value: constant Employee_Filing_EX. 

256 deptkeybuffer := (dept => 100); 

257 — Lowest department for 

258 — ascending key field. 
259 

260 stop_key_descr: constant 

261 Record_AM.key_value_descr : = ( 

262 stop_key_value' address, 

263 stop_key_value' size / 8); 
264 

265 begin 

266 Record_AM . Keyed_Ops . Set_key_range ( 

267 opened_dev => opened_file, 

268 index => 

269 Empl oyee_Fi 1 i ng_EX . dept_i ndex_name , 

270 select_range => ( 

271 start_comparison => Record_AM. exclusive, 

272 start_value => start_key_descr, 

273 stop_comparison => Record_AM. inclusive, 

274 stop_value ==> stop_key_descr) ) ; 
275 

276 loop 

277 bytes_read := Record_AM. Ops. Read ( 

278 opened_dev => opened_file, 

279 modifier => Record_AM. prior, 

280 — Sets read modifier to prior. 

281 buffer_VA => buffer' address, 

282 length => buffer' length) ; 
283 

284 — DO ANY NEEDED PROCESSING HERE. 
285 

286 end loop; 

287 exception 

288 when Device_Defs.end_of_file => 

289 null; 

290 end Read_prior_simple_index; 
291 

292 
293 

294 procedure Read_duplicates ( 

295 opened_file: Device_Defs.opened_device) 

296 — An opened device, opened for input on an 

297 — employee file. 

298 is 

299 start_key_value : constant Employee_Filing_EX. 

300 dept_key_buffer := (dept => 305); 

301 — Start value for duplicate 

302 -- key field. 
303 

304 

305 start_key_descr: constant Record_AM. 
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306 key_value_descr :=■ ( 

307 start_key_yalue' address, 

308 start_key_value'size / 8); 
309 

310 stop_key_value: constant Employee_Filing_EX. 

311 dept_key_buffer := (dept => 305); 

312 — Stop value for duplicate 

313 -- key field. 
314 

315 

316 stop_key_descr: constant Record_AM. 

317 ' key_value_descr := ( 

318 stop_key_value' address, 

319 stop_key_value'size / 8); 

320 begin 

321 Record_AM . Keyed_Ops . Set_key_range ( 

322 opened_dev => opened_file, 

323 index =•> Employee_Filing_EX. 

324 dept_index_name, 

325 select_range => ( 

326 start_comparison => Record_AM. inclusive, 

327 start_value => start_key_descr, 

328 stop_comparison => Record_AM. inclusive, 

329 stop_value => stop_key_descr) ) ; 

330 loop 

331 bytes_read := Record_AM. Ops. Read ( 

332 opened_dev => opened_file, 

333 modifier =»> Record_AM.next, 

334 — ■ Normally defaulted. 

335 buffer_VA => buffer' address, 

336 length => buffer' length) ; 
337 

338 ~ DO ANY PROCESSING HERE 
339 

340 end loop; 

341 exception 

342 when Device_Defs.end_of_file => 

343 null; 
344 

345 end Read_duplicates; 
346 

347 procedure Delete_records_sequential ( 

348 opened_file: Device_Defs.opened_device) 

349 — An opened device, opened for input on an 

350 — employee file. 

351 — Logic: 

352 — Do a Set_key_range for a range of departments 

353 — to delete. Set up a loop for the deletes with 

354 — the position_modifer = current. (Key point: a 

355 — Read or Set_position is not required to 

356 — preface each Delete in the loop. The current 

357 — record pointer advances after each Delete) 
358 

359 is 

360 start_key_value: constant Employee_Filing_EX. 

361 dept_key_buffer := (dept => 150); 

362 — Low end for ascending key field. 
363 

364 start_key_descr: constant Record_AM. 

365 key_value_descr := ( 

366 st art_key_value ' address, 

367 start_key_value' size / 8); 
368 

369 stop_key_value: constant Employee_Filing_EX. 

370 dept_key_buffer := (dept => 200); 

371 — High end for ascending 

372 — key field. 
373 

374 stop_key_descr: constant Record_AM. 

375 key_value_descr := ( 

376 stop_key_value' address, 

377 stop_key_value' size / 8); 

378 begin 

379 Record_AM.Keyed_Ops.Set_key_range ( 

380 opened_dev => opened_file, 

381 index => Employee_Filing_EX. 

382 dept_index_name, 
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383 select_range => ( 

384 start_comparison => Record_AM. inclusive, 

385 start_value -> start_key_descr, 

386 stop_comparison => Record_AM. inclusive, 

387 stop_value => stop_key_descr) ) ; 

388 loop 

389 — CRP is updated after each delete 

390 — (no read is necessary to preface 

391 — the Delete) . 

392 Record_AM.Ops.Delete( 

393 opened_dev =»> opened_file, 

394 modifier »> Record_AM. current, 

395 — Normally defaulted. 

396 timeout => Record_AM.wait_forever, 

397 status => null); 
398 

399 end loop; 
400 

401 exception 

402 when Device_Defs.end_of_file => 

403 null; 
404 

405 end Delete_records_sequential; 

406 

407 

408 procedure Read_and__update_by_key ( 

409 opened_file: Device_Defs.opened_device) 

410 — An opened device, opened for input on an 

411 — employee file. 
412 

413 — Logic: 

414 — Do a Set_key_range for a range of departments 

415 — to update. Set up a read loop using 

416 — position_modifier = next. Do a comparison 

417 — to trap a record to update. When rec_in = 

418 — record_of_interest, do an Update_by_key . 

419 — (Key point: the current record pointer does 

420 — NOT advance after the Update_by_key . ) 

421 is 

422 start_key_value: constant Employee_Filing_EX. 

423 dept_key_buffer := (dept => 100); 

424 — Lowest dept for ascending key field. 
425 

426 start_key_descr: constant Record_AM. 

427 key_value_descr := ( 

428 st art_key_value' address, 

429 start_key_value' size / 8); 
430 

431 stop_key_value: constant Employee_Filing_EX. 

432 dept_key_buffer := (dept => 200); 

433 — High end for ascending 

434 — key field. 
435 

436 stop_key_descr: constant Record_AM. 

437 key_value_descr := ( 

438 stop_key_value' address, 

439 stop_key_value' size / 8) ; 

440 begin 

441 Record_AM . Keyed_Ops . Set_key_range ( 

442 opened_dev => opened_file, 

443 index => Employee_Filing_EX.dept_index_name, 

444 select_range => ( 

445 start_comparison => Record_AM. inclusive, 

446 start_value => start_key_descr, 

447 stop_comparison => Record_AM. inclusive, 

448 stop_value => stop_key_descr) ) ; 

449 loop 

450 bytes_read := Record_AM. Ops. Read ( 

451 opened_dev => opened_file, 

452 modifier => Record_AM.next, 

453 buffer_VA => buffer' address, 

454 length => buffer' length) ; 
455 

456 if current_record_VA.dept = 175 then 

457 — CRP does not advance to next record 

458 — after the Update_by_key (it advances on 

459 — next read) . 
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4 60 Record_AM . Keyed_Ops . Update_by_key ( 

461 opened_dev => opened_file, 

462 buffer_VA -> buffer' address, 

463 length => buff er' length, 

464 index -> Employee_Filing_EX. 

465 dept_index_name) ; 

466 — Employee ID index (hashed) . 

467 end if; 

468 end loop; 

469 exception 

470 when Device_Defs.end_of_file => 

471 null; 

472 end Read_and_update_by_key; 
473 

474 

475 procedure Read_records_reverse_sequential ( 

476 opened_file: Device_Defs.opened_device) 

477 — An opened device, opened for input on an 

478 — employee file. 
479 

480 is 

481 begin 

482 Record_AM.Ops.Set_position( 

483 opened_dev => opened_file, 

484 where => Record_AM.record_specifier ( 

485 type_of_specifier => Record_AM.last) ' ( 

486 type_of_specifier => Record_AM.last) ) ; 

487 — Positions current record pointer 

488 — to last record in file. 

489 loop 

490 bytes_read := Record_AM. Ops. Read ( 

491 opened_dev => opened_file, 

492 modifier => Record_AM. prior, 

493 buffer_VA => buffer' address, 

494 length => buffer' length) ; 
495 

496 —DO ANY NEEDED PROCESSING HERE. 

497 

498 end loop; 

499 

500 

501 exception 

502 when Device_Defs.end_of_file => 

503 null; 

504 end Read_records_reverse_sequential; 
505 

506 

507 procedure Read_records_sequential ( 

508 opened_file: Device_Defs.opened_device) 

509 — An opened device, opened for input on an 

510 — employee file. 
511 

512 is 

513 begin 

514 Record_AM.Ops.Set_position( 

515 opened_dev ==> opened_file, 

516 where => Record_AM.record_specifier ( 

517 type_of_specifier => Record_AM. first) ' ( 

518 type_of_specifier => Record_AM. first ) ) 

519 loop 

520 bytes_read := Record_AM. Ops. Read ( 

521 opened_dev -> opened_file, 

522 buffer_VA => buffer' address, 

523 length => buffer' length) ; 
524 

525 -- DO ANY NEEDED PROCESSING HERE. 

526 

527 end loop; 

528 

529 exception 

530 when Device_Defs.end_of_file => 

531 null; 
532 

533 end Read_records_sequential; 

534 

535 

536 procedure Read_and_delete_records ( 
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537 opened_file: Device_Defs.opened_device) 

538 — An opened device, opened for input on an 

539 — employee file. 

540 is 

541 begin 

542 Record_AM.Ops.Set_position( 

543 opened_dev => opened_file, 

544 where => Record_AM.record_specifier ( 

545 type_of_specifier => Record_AM. first) ' ( 

546 type_of_specifier => Record_AM. first) ) ; 

547 loop 

548 bytes_read := Record_AM. Ops- Read ( 

549 opened_dev => opened_file, 

550 buffer_VA => buffer' address, 

551 length => buffer' length) ; 
552 

553 if current_record_VA.dept =175 then 

554 Record_AM.Keyed_Ops. Delete_by_key { 

555 opened_dev => opened_file, 

556 index => Employee_Filing_Ex. 

557 dept_index_name) ; 
558 

559 end if; 

560 

561 end loop; 

562 

563 exception 

564 

565 when Device_Defs.end_of_file =o> 

566 null; 
567 

568 end Read_and_delete_records; 

569 

570 

571 procedure Read_and_update_records ( 

572 opened_file: Device_Defs.opened_device) 

573 — An opened device, opened for input on an 

574 — employee file. 
575 

576 is 

577 begin 

578 Record_AM.Ops.Set_position (opened_file, 

579 where => Record_AM.record_specifier ( 

580 type_of_specifier => Record_AM. first) ' ( 

581 type_of_specifier => Record_AM. first) ) ; 

582 loop 

583 bytes_read := Record_AM.Ops.Read( 

584 opened_dev => opened_file, 

585 buffer_VA => buffer' address, 

586 length => buffer' length) ; 
587 

588 current_record_VA. salary := 

589 pay_raise * cur rent_record_VA. salary; 
590 

591 Record_AM. Ops. Update ( 

592 opened_dev => opened_file, 

593 buffer_VA => buffer' address, 

594 length => buffer' length) ; 

595 end loop; 
596 

597 

598 exception 

599 when Device_Defs.end_of_file => 

600 null; 

601 end Read_and_update_records; 
602 

603 

604 procedure Update_salary_example { 

605 T2_opened_file: Device_Defs.opened_device) 

606 — An opened device for transaction Tl, opened 

607 — for input on an employee file. 
608 

609 is 

610 begin 

611 Transaction_Mgt . Start_transact ion; 

612 — Started on behalf of transaction T2, the 

613 — updater. 
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614 

615 — The record must have been positioned to by a 

616 — previous read, otherwise a 

617 — Record_AM.key_value_descr must be specified. 

618 — No key range is necessary. The current record 

619 — pointer is not affected. 
620 

621 current_record_VA. salary := 

622 pay_raise * current_record_VA. salary; 
623 

624 — Default is the current record. 

625 Record_AM . Keyed_Ops . Update_by_key ( 

626 opened_dev => T2_opened_file, 

627 buffer_VA => buffer' address, 

628 length => buffer' length, 

629 index => Employee_Filing_EX. 

630 dept_salary_index_name) ; 

631 — Employee ID index. 
632 

633 exception 

634 when Device_Defs.end_of_file => 

635 Transact ion_Mgt.Commit_transaction; 
636 

637 when others => 

638 Transaction_Mgt . Abort_transaction; 
639 

640 end Update_salary_example; 

641 

642 

643 end Record AM Ex; 
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X-A.4.17 Simple_editor — cmd_ex Procedure 



1 with Command_Handler, 

2 Device_Defs, 

3 Simple_Editor_Ex; 
4 

5 _. 

6 -- SIMPLE EDITOR 

7 . 

8 procedure Simple_editor_cmd_ex 
9 

10 — Functions 

11 — This procedure implements a simple text 

12 — editor for the purpose of demonstrating certain 

13 — aspects of the Character Display Access Method. 
14 

15 — Command Definition: 

16 — The command has the form: 
17 

18 — simple_editor_cmd_ex :name=<symbolic_name (1. .80) > 
19 

20 — *D* 

21 — *D* manage . commands 

22 — *D* create. invocation_command 

23 __* D * 

24 — *d* define. argument name \ 

25 — *D* :type = string 

26 — *D* set.lexical_class symbolic_name 

27 — *d* set . maximum_length 80 

28 — *D* set. mandatory 

29 — *d* end 

30 — *d* end 

31 — *D* exit 
32 

33 — End of Header 

34 

35 is 

36 

37 opened_cmd: Device_Def s.opened_device; 

38 

39 begin 

40 

41 — Get command arguments: 

42 

43 opened_cmd := Command_Handler. 

44 Open_invocation_command_processing; 
45 

46 Command_Handler.Get_string( 

47 cmd_odo => opened_cmd, 

48 arg_number => 1, 

49 arg_value => Simple_Editor_Ex.file_name) ; 
50 

51 Command_Handler. Close (opened_cmd) ; 
52 

53 — NOTE: allocation is done here rather than at the 

54 — declaration due to the exception 

55 — "Object has no representation" being raised 

56 — if the Get_object_size is called before the object 

57 — is accessed 

58 Simple_Editor_Ex.edit_buffer := 

59 new Simple_Editor_Ex.edit_buf fer_object' ( 

60 max_lines => Simple_Editor_Ex.resize_lines, 

61 num_lines => 0, 

62 lines => (others => (others => ASCII. NUL) ) ) ; 
63 

64 Simple_Editor_Ex.Read_f ile; 

65 

66 Simple_Edi tor_Ex . Make_window; 

67 

68 Simple_Editor_Ex.Handle_input; 

69 

70 end Simple editor cmd ex; 
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X-A.4.18 simpie_Editor_Ex Package Specification 



1 with Incident_Defs, 

2 SystemJDefs, 

3 System, 

4 Terminal_Defs; 
5 

6 package Simple_Editor_Ex is 
7 

8 — Function: 

9 — This package implements procedures to support a 

10 — simple text editor for the purpose of demonstrating 

11 — certain aspects of the Character Display Access Method. 
12 

13 — The editor has the following attributes: 
14 

15 — 1. The file is read into an array of lines of characters, 

16 — Each line in 80 characters (screen width) 
17 

18 — 2. If the file does not exist it will be created. 

19 

20 — 3. The array will expand to any size file. 

21 

22 — 4. The array is null-filled before the 

23 — file is read in. (Character_Display_AM 

24 — will ignore the nulls) 
25 

26 — 4. Each line in the file is read into 

27 — one row in the array. Long lines (>80) will be 

28 — preserved but they cannot be altered by the editor. 
29 

30 — 5. The frame buffer is 24 by 80 (screen size) . 
31 

32 — 6. If changes have been made since the last save 

33 — it will prompt the user if ok to exit. 
34 

35 — 7. The bell will ring for illegal commands. 

36 

37 — The operations available in the editor are: 

38 

39 — * Move forward (Control F) 

40 — * Move backward (Control B) 

41 — * Move up (Control P) 

42 — * Move down (Control N) 

43 — * Page up (Control U) 

44 — * Page down (Control V) 

45 — * Delete forward (Control D) 

46 — * Delete backward (Control H) 

47 — * Insert text 

48 — * Save file (Control W) 

49 — * Quit editor (Control C) 
50 

51 -- History: 

52 — ll/??/86, G. Taylor : Initial version 

53 — 12/??/87, E. Sassone : Revised version 

54 — 12/19/87, G. Taylor : Added tagged comments 

55 — 06/15/88, E. Sassone : working version 
o 6 — — 

57 — Exception Codes: 
58 

59 new_file_code: constant Incident_Defs.incident_code := ( 

60 module => 0, 

61 number => 1, 

62 severity => Incident_Defs. information, 

63 message_object => System. null_word) ; 
64 

65 not_saved_code : constant Incident_Defs.incident_code := ( 

66 module => 0, 

67 number => 2, 

68 severity => Incident_Defs. warning, 

69 message_object => System. null_word) ; 
70 

71 no_long_lines_code: constant Incident_Defs.incident_code := ( 

72 module => 0, 

73 number => 3, 

74 severity => Incident Defs. information, 
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message_object => System. null_word) ; 

editor_error_code: constant Incident_Defs.incident_code := ( 
module => 0, 
number =»> 4, 

severity => Incident_Defs. error, 
message_object => System. null_word) ; 

— Exceptions: 

— *D* manage. mess ages 

no_access: exception; 

— *D* store :module=0 :number=l \ 

__*n* :msg_name=new_file_code \ 

— *D* : short - \ 

— *D* "$pl<pathname> is a new file." 

— *D* store :module=0 :number=2 \ 

— *D* :msg_name=not_saved_code \ 

— *D* : short = \ 

— * D * "Changes have not been saved. Exit anyway? " 

. — *D* store :module=0 :number=3 \ 

— *D* :msg_name=no_long_lines_code \ 

— *D* s short = \ 

— *n* "Changes to long lines NYI" 

editor_error: exception; 

— *D* store :module=0 :number=4 \ 

— *D* :msg_name=editor_error_code \ 

— *D* : short = \ 

— *n* "Editor_error - please save your file and quit" 

— End of Header 



CONSTANTS 

constant Terminal_Defs.point_info := (1, 1); 



origin: 

— frame buffer origin 

first row: 



constant integer := 1; 



constant 
constant 


integer 
integer 


:- 1; 
:= 80; 


constant 


integer 


:= 24; 


constant 


integer 


:= 10; 



first_column: 
last_column: 

frante_rows: 

— screen size 

pref erred_window_rows : 

— initial window size 



linear_buf_size: constant := 4_096; 

— size of read/write buffer 

resize_lines: constant := 100; 

— number of lines to add for resizing edit buffer 

— object 



TYPES 

subtype row_delta is integer range -1 . . 1; 

subtype row_range is positive; 

subtype column_range is integer range 1 . . last_column; 

— position in edit_buffer 
type cursor_location is 
record 

row: row_range; 
column: column_range; 
end record; 



— edit buffer 

type line 

type edit array 



is array (column_range) of character; 
is array (integer range <>) of line; 



yk~A~oO 
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type edit_buf fer_ob ject ( 

max_lines: integer) is 
record 

num_lines: integer := 0; 

lines: edit_array (first_row .. max_lines) ; 
end record; 

type edit_buffer_AD is access edit_buffer_object; 
pragma access_kind(edit_buf fer_AD, AD); 

— for input of command and insertions chars 
type char_array is array (1 . . 120) of character; 
type char_array_AD is access char_array; 
pragma access kind (char array AD, AD); 



VARIABLES 

file_name: System_Defs.text (Incident_Defs.txt_length) 
edit buffer: edit buffer AD; 



PROCEDURES 



function Move_page ( 

direction: row_delta) 
return boolean; — operation successful 

— Function: 

— Move up or down by the size of the view 



function Move_up 
return boolean; 



— operation successful 



— Function: 

— Moves the cursor up one line, but not 
beyond the beginning of the file. 



function Move_down 
return boolean; 



— operation successful 



— Function: 

Moves the cursor down one line, but not 
beyond the end of the file. 



function Move_forward 
return boolean; 



— operation successful 



— Function: 

Moves the cursor forward one character 
but not beyond the end of the line. 



function Move_back 
return boolean; 



— operation successful 



— Function: 

Moves the cursor backward one character, but not 

— beyond the beginning of the line. 



function Delete_forward 

return boolean; — operation successful 

— Function: 

— Deletes the character at the cursor' s current 

— position. Cursor position in unchanged. 
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229 

230 

231 function Delete_backward 

232 return boolean; — operation successful 
233 

234 — Function: 

235 — Deletes the character to the left of the cursor, 

236 — but not beyond the beginning of the line. 
237 

238 
239 

240 function Insert ( 

241 insert_char: character) 

242 return boolean; — operation successful 
243 

244 — Function: 

245 — Insert printable characters to the left of the 

246 — cursor. 
247 

248 

249 

250 procedure Save_file; 

251 

252 — Function: 

253 — Writes the file from the edit buffer. 
254 

255 

256 

257 procedure Quit_editor; 

258 

259 — Function: 

260 — Exits the editor If changes have been made 

261 — since the last save it will ask the user 

262 — whether the unsaved changes should be saved or 

263 — not. Returns cursor to old window. 
264 

265 

266 

267 procedure Read_file; 

268 

269 — Function: 

270 — Reads the sections of the input file into the 

271 -- edit buffer. 
272 

273 

274 

275 procedure Make_window; 

276 

277 — Function: 

278 — Creates a new window for editing. 
279 

280 

281 

282 procedure Handle_input; 

283 

284 — Function: 

285 — Loops waiting for editor keyboard and menu input. 
286 

287 

288 procedure Key_input ( 

289 key: character); 
290 

291 — Function: 

292 — Calls the appropriate procedure based on the 

293 — key input. 
294 

295 

296 end Simple Editor Ex; 
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X-A.4.19 simpie_Editor_Ex Package Body 



1 with Byte_Stream_AM, 

2 Character_Display_AM, 

3 Device_Defs, 

4 Directory_Mgt, 

5 File_Defs, 

6 Incident_Defs, 

7 Long_Integer_Defs, 

8 Message_Services, 

9 Object_Mgt, 

10 Process_Mgt, 

11 Process_Mgt_Types, 

12 Simple_File_Admin, 

13 System, 

14 System_Defs, 

15 Terminal_Defs, 

16 Text_Mgt, 

17 Window_Services; 
18 

19 package body Simple_Editor_Ex is 
20 

21 

22 ~ VARIABLES 

23 

24 — position of frame buffer in edit_buffer 

25 frame_begin: row_range := first_row; 

26 frame_end: row_range : = frame_rows; 
27 

28 edit_buf_pos: cursor_location := (first_row, first_column) ; 
29 

30 old_window: Device_Defs. device; 

31 — window editor was invoked from 

32 edit_window: Device_Defs. device; 

33 open_edit_window: Device_Defs.opened_device; 

34 saved: boolean := true; 

35 — true if current version has been saved 
36 

37 

38 — LAST CHAR IN ROW 

39 

40 function Last_char_in_row (row: row_range) 

41 return column_range 
42 

43 — Logic: 

44 — Starts from the last column of the given row and works 

45 — toward the start of the line to detect the first non-null 

46 — character. 
47 

48 is 

49 

50 column: column_range := last_column; 

51 

52 begin 

53 

54 while edit_buffer. lines (row) (column) = ASCII. NUL 

55 loop 

56 if column = first_column then 

57 EXIT; 

58 else 

59 column := column - 1; 

60 end if; 

61 end loop; 

62 return (column) ; 

63 end Last_char_in_row; 
64 

65 

66 ~ MOVE FRAME 

67 

68 procedure Mo ve_frame (direction: integer) 
69 

70 — Logic: 

71 — Move frame in edit buffer and rewrite frame buffer. 

72 — Reposition cursor appropriately 
73 

74 is 
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75 column: column_range := edit_buf_pos. column; 

76 — holds cursor position in previous row 

77 begin 

78 frame_begin := frame_begin + direction; 

79 frame_end := frame_end + direction; 

80 edit_buf_pos.row := edit_buf_pos.row + direction; 
81 

82 Character_Display_AM. Ops .Clear (open_edit_window) ; 
83 

84 — Rewrite frame buffer 

85 — NOTE: cursor will be at the end of the frame buffer 

86 Character_Di splay _AM. Ops. Write { 

87 opened_dev => open_edit_window, 

88 buffer_VA => 

89 edit_buffer. lines (frame_begin) (first_column) ' address, 

90 length => System. ordinal ( (last_column * (frame_rows - 1) ) + 

91 Last_char_in_row (frame_end) - 1)); 
92 

93 if direction > then 

94 — down: 

95 — position at the first column of the last line 

96 if column > Last_char_in_row (frame_end) then 

97 column := Last_char_in_row (frame_end) ; 

98 end if; 

99 Character_Display_AM.Ops.Move_cursor_absolute ( 

100 opened_dev => open_edit_window, 

101 new_pos => Terminal_Defs.point_info' 

102 (column, integer (f rame_rows) ) ) ; 

103 end if; 

104 if direction < then 

105 — up: 

106 — after write, cursor will be at last char written 

107 — for upward movement we want it at the first char in 

108 — the frame buffer 

109 if column > Last_char_in_row (frame_begin) then 

110 column := Last_char_in_row (frame_begin) ; 

111 end if; 

112 Character_Display_AM.Ops.Move_cursor_absolute ( 

113 opened_dev => open_edit_window, 

114 new_pos => (column, first_row) ) ; 

115 end if; 

116 end Move_frame; 
117 

118 

119 — MOVE PAGE 

120 

121 function Move_page (direction: row_delta) 

122 return boolean 

123 is 

124 window_status: Window_Services.window_status := 

125 Window_Services.Ops.Get_window_status ( 

126 window => edit_window, 

127 pixel_units => false) ; 

128 displacement: integer := 

129 window_status.window_dimensions.vert * direction; 

130 cursor_pos: Terminal_Defs.point_info := 

131 Character_Di splay _AM. Ops. Get_cursor_position (open_edit_window) ; 
132 

133 begin 

134 if direction > then 

135 — if too close to the bottom move by less than window size 

136 if frame_end + displacement > edit_buffer.max_lines then 

137 displacement := edit_buf fer.max_lines - frame_end; 

138 end if; 

139 end if; 

140 if direction < then 

141 — if too close to the top move by less than window size 

142 if frame_begin + displacement < first_row then 

143 displacement := first_row - frame_begin; 

144 end if; 

145 end if; 
146 

147 Move_frame (displacement) ; 

148 Character_Display_AM.Ops.Move_cursor_absolute ( 

149 opened_dev => open_edit_window, 

150 new_pos => cursor_pos) ; 

151 edit_buf_pos.row := frame_begin + (cursor_pos.vert - 1); 
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if displacement 
return false; 

else 

return true; 

end if; 
end Move_page; 



then 



MOVE CURSOR 



procedure Move_cursor (direction: row_delta) 
is 

— used for current cursor position 
cursor_jpos: Terminal_Defs.point_info : = 

Character_Display_AM.Ops.Get_cursor_position(open_edit_window) 

— last column of row where cursor will be 

last_col: column_range := Last_char_in_row(edit_buf_pos.row + 
direction) ; 

begin 

edit_buf _pos . row := edit_buf_pos.row + direction; 

if cursor_jpos.horiz <= last_col then 

— Move cursor in frame buffer straight up or down 
Character_Di splay _AM. Ops. Move_cursor_relative ( 

opened_dev => open_edit_window, 
delta_col => 0, 
delta_row => direction) ; 
else 

— Move cursor to end of line 
Character_Display_AM. Ops . Move_cursor_absolute ( 

opened_dev => open_edit_window, 
new_pos => (last_col, edit_buf_pos.row) ) ; 
edit_buf_pos. column := last_col; 
end if; 
end Move cursor; 



MOVE UP 

function Move_up 
return boolean 

is 

success: boolean : = true; 
begin 

if edit_buf_pos.row <= first_row then 

success := false; 
elsif edit_buf_pos.row <= frame_begin then 

Move_f rame (-1) ; 
else 

Move_cursor (-1) ; 
end if; 

return success; 
end Move_up; 



MOVE DOWN 

function Move_down 
return boolean 



success: boolean := true; 
begin 

if edit_buf_pos.row >= edit_buffer.num_lines then 

success := false; 
elsif edit_buf_pos.row >= frame_end then 

Move_f rame (+1) ; 
else 

Move cursor (+1); 



Ada Examples 



X-A-91 



m ixuuiiruiifnivi 



229 end if; 

230 return success; 

231 end Move_down; 
232 

233 

234 

235 — MOVE FORWARD 

236 

237 function Move_forward 

238 return boolean 



239 

240 — Logic: 

241 — If cursor is at end of row then move cursor to 

242 — first column of next row; else move cursor 

243 — forward one column. If cursor is at the end of 

244 — of the buffer return false. 
245 

246 is 

247 current _jpos: Terminal_Defs.point_info; 

248 success: boolean := true; 

249 begin 
250 

251 if edit_buf_jpos. column - Last_char_in_row(edit_buf_pos.row) then 

252 if edit_buf_pos.row = edit_buffer.num_lines then 

253 success :=» false; — at the end of buffer 

254 else 

255 — Move cursor to next row in frame and 

256 — frame buffer 

257 success := Move_down; 

258 if not success then return success; end if; 

259 — Move cursor to beginning of row in frame 

260 — and frame buffer 

261 current_jpos := Character_Display_AM.Ops. 

262 Get_cursor_position (open_edit_window) ; 

263 current_pos.horiz := first_column; 

264 Character_Display_AM.Ops.Move_cursor_absolute ( 

265 opened_dev => open_edit_window, 

266 new_pos => current_pos) ; 

267 edit_buf_pos. column := first_column; 

268 end if; 

269 else 

270 — move cursor to next column 

271 edit_buf_pos. column := edit_buf_pos. column + 1; 

272 Character_Display_AM.Ops.Move_cursor_relative ( 

273 opened_dev => open_edit_window, 

274 delta_col => 1, 

275 delta_row => 0); 

276 end if; 

277 return success; 

278 end Move_forward; 
279 

280 

281 

282 — MOVE BACK 

283 

284 function Move_back 

285 return boolean 
286 

287 — Logic: 

288 — If cursor is at beginning of row then move cursor 

289 — to last column of previous row; else move cursor 

290 — back one column. If cursor is at the beginning of 

291 — the file then return false. 
292 

293 is 

294 current_pos: Terminal_Defs.point_info; 

295 success: boolean := true; 

296 begin 
297 

298 if edit_buf_pos. column = first_column then 

299 if edit_buf_pos. row = first_row then 

300 Character_Display_AM.Ops.Ring_bell ( 

301 open_edit_window) ; 

302 success := false; 

303 else 

304 — Move cursor to previous row in frame and 

305 — frame buffer 
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success : = Move_up; 

if not success then return success; end if; 

— Move cursor to end of row 

edit_buf_pos. column := last_char_in_row(edit_buf_j?os.row) 

current_pos := Character_Display_AM.Ops. 

Get_cursor_position(open_edit_window) ; 
current_pos.horiz :=» edi t_buf_jpos. column; 
Character_Di splay _AM. Ops. Move_cursor_absolute ( 
opened_dev => open_edit_window, 
new_pos => current_pos) ; 
end if; 
else 

— move cursor to previous column 
edi t_buf_pos. column := edi t_buf_pos. column - 1; 
Character_Display_AM.Ops.Move_cursor_relative ( 
opened_dev => open_edit_window, 
delta_col => -1, 
delta_row => 0); 
end if; 
. return success; 
end Move back; 



DELETE FORWARD 

function Delete_forward 
return boolean 

— Logic: 

— Procedure will not delete characters from long 
lines. It then determines if the the character 
to be deleted is a line feed or not. If not it 
simple deletes the character and shifts 
characters beyond it one position to the left. 
If the character is a line feed it determines if 
the line is empty or not. If so if deletes the 
line. If not it joins the current line with the 

— next line. In both cases lines beyond the 
current line are shifted up by one row. 



— place holders for line joins 
cursorjpos: Terminal_Defs.point_info := 

Character_Display_AM.Ops.Get_cursor_position( open_edit_window) 
edit_pos: cursor_location :=* edit_buf_pos; 

begin 

— no deletes on long lines 

if Last_char_in_row (edit_buf_pos.row) = last_column then 

Message_Services.Write_msg (no_long_lines_code) ; 

return false; 
end if; 
if edi t_buf_pos. column = Last_char_in_row (edit_buf_pos.row) then 

if edit__buf_pos.row = edit_buffer.num_lines then 
return false; 

end if; 
end if; 

— not a line feed 

if edit_buf fer. lines (edi t_buf_pos. row) (edi t_buf_jpos. column) 
/= ASCII. LF then 
— Delete the character from the frame, 
if edi t_buf_pos. column = last_column then 

edit_buf fer . lines (edit_buf_pos . row) (edit_buf_pos . column) 
:= ASCII.NUL; 
else 

for col in edit_buf_pos. column. .last_column - 1 loop 
edit_buffer. lines (edi t_buf_pos. row) (col) := 

edit_buffer. lines (edi t_buf_pos. row) (col + 1); 
end loop; 
end if; 

edit_buffer. lines (edit_buf_pos. row) (last_column) := ASCII.NUL; 

— Delete the character from the window. 
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383 Character_Display_AM.Ops.Delete_char ( 

384 opened_dev => open_edit_window) ; 
385 

386 — line feed 

387 else 

388 — not the last line 

389 if edit_buf jpos.row < edit_buffer.num_lines then 

390 — empty line delete 

391 if edit_buf_pos. column = first_column then 

392 — shift rows down by one 

393 for row in edit_buf_pos.row .. edit_buffer.num_lines - 1 

394 loop 

395 edit_buffer. lines (row) : = edit_buffer. lines (row +1); 

396 end loop; 

397 edit_buffer. lines (edit_buffer.num_lines) := 

398 (others => ASCII. NUL); 

399 edit_buffer.num_lines := edit_buffer.num_lines - 1; 

400 Character_Display_AM.Ops.Delete_line (open_edit_window) ; 

401 — join current line and next line 

402 else 

403 — don't join if line wiil be too long 

404 if Last_char_in_row (edit_buf_pos.row) + 

405 Last_char_in_row (edit_buf_pos.row +1) >= last_column then 

406 return false; 

407 end if; 

408 for col in first_column .. Last_char_in_row ( 

409 edit_buf jpos.row + 1) 

410 loop 

411 edit_buffer. lines (edit_buf__pos. row) (edit_buf_pos. column) : = 

412 edit_buffer.lines(edit_buf_pos.row + l)(col); 

413 edit_buf_pos. column := edit_buf_jpos. column + 1; 

414 EXIT when edit_buf_pos. column = last_column; 

415 end loop; 

416 edit_buf_pos.row := edit_buf_pos.row + 1; 

417 — shift rows down by one 

418 for row in edit_buf_pos.row .. edit_buffer.num_lines - 1 

419 loop 

420 edit_buffer. lines (row) := edit_buffer. lines (row + 1); 

421 end loop; 

422 edit_buffer. lines (edit_buffer.num_lines) := 

423 (others => ASCII. NUL); 

424 edit_buffer.num_lines := edit_buf fer.num_lines - 1; 

425 Move_f rame ( ) ; — redraw 

426 edit_buf_pos := edit_pos; 

427 Character_Display_AM.Qps.Move_cursor_absolute ( 

428 opened_dev => open_edit_window, 

429 new_pos => cursor_pos); 

430 end if; 

431 — last line 

432 else 

433 edit_buffer. lines (edit_buf_pos. row) (edit_buf_jpos. column) := 

434 ASCII. NUL; 

435 end if; 

436 end if; 

437 return true; 

438 end Delete_forward; 
439 

440 

441 

442 ~ DELETE BACKWARD 

443 

444 function Delete_backward 

445 return boolean 
446 

447 — Logic: 

448 -- Very similar to Delete_forward except the cursor 

449 — is move back before the delete is performed. 
450 

451 is 

452 success: boolean := true; 

453 res: boolean; 

454 begin 
455 

456 if Move_back then — back up cursor 

457 success := Delete_forward; — Delete the character. 

458 — leave cursor pos unchanged if unsuccessful 

459 if not success then res := Move forward; end if; 
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else 

success := false; 
end if; 

return success; 
end Delete backward; 



INSERT 



function Insert (insert_char: character) 
return boolean 

— Logic: 

— Shifts the string of characters beginning at the 
cursor' s location one character position to the 
right. It then inserts a printable ASCII character 
to the left of the cursor. If a line is already 

80 characters the insert is refused. Line feeds 

— are inserted by first moving all the rows beyond the 
current row down by one. If there are characters 

on the current line beyond the insert point they 
are copied to the new line. If not just a line- 
feed in put into the new line. If the file grows 
beyond the current max_line size it is expanded by 
resize lines. 



is 

use System; — for adding System. ordinals 

max_lines: integer; 

For max_lines USE AT edit_buffer.max_lines' address; 

edit_buffer_untyped: System. untyped_word; 

FOR edit_buffer_untyped USE AT edit_buffer' address; 

— place holders for line splits 
cursorjpos: Terminal_Defs.point_info := 

Character_Display_AM.Ops.Get_cursor_position (open_edit_window) 
edit_pos: cursor_location := edit_buf_pos; 
column: column_range := first_column; 

success: boolean := true; 

begin 

— inserts on long lines NYI 

if Last_char_in_row(edit_buf_pos.row) = last_column then 
Message_Services.Write_msg (no_long_lines_code) ; 
return false; 

end if; 

— If the current column is the last column in the 

— view, insert the new character in the frame; 

— else shift trailing characters one column to 

— the right and insert the new character. 

if insert_char /= ASCII. LF then 

if edit_buf_pos. column = last_column then 
edit_buffer. lines (edit_buf_pos.row) 

(edit_buf_pos. column) := insert_char; 
else 

— right shift characters to the right of insert position 
for index in reverse edit_buf_pos. column + 1 .. last_column 
loop 

edit_buf fer. lines (edit_buf_pos. row) (index) := 

edit_buf fer. lines (edit_buf_pos. row) (index - 1); 
end loop; 

edit_buf fer. lines (edit_buf_pos.row) 

(edit_buf_pos. column) := insert_char; 
edit_buf_pos. column := edit_buf_pos. column +1; 
end if; 

— Insert the character in the frame buffer 

— (Frame buffer cursor is moved automatically) 
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537 Character_Display_AM.Ops.Insert_char ( 

538 opened_dev => open_edit_window, 

539 buffer_VA => insert_char' address, 

540 num_char => 1) ; 
541 

542 — return 

543 else 

544 — shift buffer lines beyond current row down by one 

545 if edit_buf fer.num_lines + 1 >= edit_buf fer.max_lines then 

546 — add resize_lines lines to current edit buffer size 

547 Ob ject_Mgt. Resize ( 

548 obj => edit_buffer_untyped, 

549 size =*> (Object_Mgt ,Get_object_size ( 

550 edit_buffer_untyped) + 

551 ordinal ( (resize_lines * last_column) / 4))); 

552 max_lines := edit_buffer.num_lines + resize_lines; 

553 edit_buf fer. lines (edi t_buffer.num_lines + 1 .. 

554 edit_buffer.max_lines) := (others ==> (others => ASCII. NUL)); 

555 end if; 
556 

557 — move row down one 

558 for row in j^@verse edit buf pos.row 'f* 1 . « edit buffer «num Ixnes 

559 loop ~ ~ ~ 

560 edit_buffer. lines (row + 1) := edit_buffer. lines (row) ; 

561 end loop; 

562 — blank fill line below current line 

563 edit_buffer. lines (edit_buf_pos. row + 1) := (others => ASCII. NUL); 

564 edit_buffer.num_lines := edit_buffer.num_lines + 1; 
565 

566 — add return to end of line 

567 if edit_buf_pos. column = Last_char_in_row (edit_buf_pos.row) then 

568 success := Move_down; 

569 — first char of new line in LF 

570 edit_buffer. lines (edit_buf_pos. row) (first_column) := ASCII. LF; 

571 edit_buf_pos. column := first_column; 

572 Character_Display_AM.Ops.Insert_line (open_edit_window) ; 

573 — insert return in the middle of the line (split line) 

574 else 

575 — copy characters past point of insert to the next line 

576 for col in edit_buf_pos. column .. Last_char_in_row (edit_buf_pos.row) 

577 loop 

578 edit_buffer. lines (edit_buf_pos. row + 1) (column) := 

579 edit_buffer. lines (edit_buf_pos. row) (col); 

580 — clear line past point of insert 

581 edit_buffer. lines (edi t_buf_pos. row) (col) := ASCII. NUL; 

582 edit_buf_pos. column := edit_buf_pos. column +1; 

583 column := column + 1; 

584 end loop; 

585 edi t_buffer. lines (edit_pos. row) (edit_pos. column) := ASCII. LF; 

586 Move_f rame ( ) ; — redraw 

587 edit_buf_pos.row := edit_buf_pos.row + 1; 

588 edi t_buf_pos. column := first_column; 

589 Character_Display_AM.Ops.Move_cursor_absolute ( 

590 opened_dev => open_edit_window, 

591 new_pos => Terminal_Defs.point_info' ( 

592 first_column, cursor_jpos.vert + 1)); 

593 end if; 

594 end if; 

595 return success; 

596 end Insert; 
597 

598 

599 

600 ~ SAVE FILE 

601 

602 procedure Save_file 
603 

604 — Logic: 

605 — Writes the file in linear_buf_size amounts copied 

606 — from the edit_buffer which is an array of lines 

607 — to the linear buffer. It checks for backslashes 

608 — in the last column and rejoins long lines. 

609 — Before writing the new file, it must be truncated 

610 — and the pointer moved back to zero. 
611 

612 is 
613 
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opened_file: Device_Defs.opened_device; 

f ile_ptr : Long_Integer_Def s . long_integer; 

linear_buf fer: array (1 . . linear_buf_size) of 

character := (others => ASCII. NUL); 
Index: integer := 1; 

begin 

opened_file := Byte_Stream_AM.Open_by_name ( 
name => file_name, 
input_output => Device_Defs. output, 
allow => Device_Def s. nothing) ; 

— delete data in original file 
Byte_Stream_AM. Ops . Truncate ( 

opened_dev => opened_file, 

new_length => Long_Integer_Defs.zero) ; 

file_ptr := Byte_Stream_AM.Ops.Setjposition ( 
opened_dev => opened_file, 
pos => Long_Integer_Defs.zero, 
mode => Byte_Stream_AM. from_begin) ; 

for row in 1 . . edit_buffer.num_lines 
loop 

— write each line to linear buffer until LF 

for col in first_column . . last_column 

loop 

— write out linear buffer when full; 
if index > linear_buf_size then 

Byte_Stream_AM. Ops. Write ( 

opened_dev => opened_file, 

buffer_VA => linear_buf fer' address, 

length => System. ordinal (linear_buf fer' size / 8)) 
linear_buffer := (others => ASCII. NUL); 
index := 1; 
end if; 

— reproduce long lines 
if col < last_column or 

edit_buffer. lines (row) (last_column) /= 'V then 
linear_buf fer (index) := edit_buffer. lines (row) (col) ; 
index := index + 1; 

EXIT when edit_buffer. lines (row) (col) = ASCII. LF; 
end if; 
end loop; 
end loop; 

Byte_Stream_AM. Ops. Write ( 

opened_dev => opened_file, 
buffer_VA => linear_buf fer' address, 
length => System. ordinal (index) ) ; 

Byte_Stream_AM. Ops. Close (opened_file) ; 

exception 

when Directory_Mgt.no_access => 
Message_Services.Write_msg ( 
msg_id => new_file_code, 

paraml => Incident_Defs.message_parameter' ( 
typ => Incident_Defs.txt, 
len => file_name. length, 
txt_val => file_name) ) ; 

end Save file; 



QUIT EDITOR 
procedure Quit_editor 
is 



quit 
begin 



exception; 
Window_Services . Ops . Transf er_input_f ocus ( 
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source_window => edit_window, 
target_window => old_window) ; 

if not saved then 

if not Message_Services.Acknowledge_Msg(not_saved_code) then 
Window_Services . Ops . Transf er_input_f ocus ( 
source_window => old_window, 
target_window => edit_window) ; 
return; 
end if; 
end if; 

Character_Display_AM. Ops. Close (open_edit_window) ; 
Window_Services.Ops . Destroy_window (edit_window) ; 
RAISE quit; 

exception 

when quit «> 
RAISE; 

end Quit editor; 



CLOSE INPUT 

— NYI (for menus) 

is 
begin 

null; 
end Close_input; 



READ FILE 
procedure Read_file 

— Logic: 

Reads the input file into a linear buffer. 

That is read one line feed to a row into 

the edit buffer. The edit buffer is expanded 

by resize lines increments as needed. 

A backslash is place in the last column for 

— lines over 80 characters long. 



use System; — for adding System. ordinals 



cha r a c t e r s_r e ad : 
opened_file: 
linear = buffer: 
col, row: 
file: 

max lines: 



System. ordinal; 

Device_Defs.opened_device; 

array (1 . . linear_buf_size) of character; 

integer := 1; 

File_Def s . f ile_AD; 

integer; 



For max_lines USE AT edit_buf fer. max_lines' address; 

edit_buf fer_untyped: System. untyped_word; 

FOR edit_buffer_untyped USE AT edit_buf fer' address; 

begin 

opened_file := Byte_Stream_AM.Open_by_name ( 
name => file_name, 
input_output => Device_Defs. input) ; 

loop 

— read by linear_buf_size blocks 
characters_read := Byte_Stream_AM.Ops.Read( 

opened_dev => opened_file, 

buffer_VA => linear_buf fer' address, 

length -> System. ordinal (linear buffer' size / 8)); 



for index in 1 



integer (characters read) 
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loop 

if row > max_lines then 

— add resize_lines lines to current edit buffer size 
Ob ject_Mgt. Resize ( 

obj => edit_buffer_untyped, 
size =»> (Object_Mgt.Get_object_size ( 
edit_buf fer_untyped) + 

ordinal ( (resize_lines * last_column) / 4))); 
max_lines := edit_buf fer.num_lines + resize_lines; 

— initialize expanded area 

edit_buffer. lines (edit_buffer.num_lines + 1 .. 
edit_buffer.max_lines) := 

(others => (others => ASCII. NUL) ) ; 
end if; 

if linear_buffer (index) = ASCII. LF then 

edit_buffer. lines (row) (col) := linear_buffer (index) ; 
edit_buffer.num_lines := edit_buffer.num_lines + 1; 
col := 1; 
row := row + 1; 
else 

if col < last_column then 

edit_buffer. lines (row) (col) := linear_buffer (index) ; 
col := col + 1; 
else — long line 

edit_buffer. lines (row) (last_column) := 'V; 
edit_buffer.num_lines := edit_buf fer.num_lines + 1; 
col := 1; 
row := row +1; 

edit_buffer. lines (row) (col) := linear_buffer (index) ; 
end if; 
end if; 
end loop; 
end loop; 

Byte_Stream_AM. Ops. Close (opened_file) ; 

exception 

— make a new file 

when Directory_Mgt .no_access => 
Message_Services.Write_msg( 
msg_id => new_file_code, 

paraml => Incident_Defs.message_parameter' ( 
typ => Incident_Defs.txt, 
len => file_name. length, 
txt_val => file_name) ) ; 
file := Simple_File_Admin.Create_file (file_name) ; 
RETURN; 

— successful completion 

when Device_Defs.end_of_file => 

Byte_Stream_AM. Ops. Close (opened_file) ; 

end Read file; 



MAKE WINDOW 

procedure Make_window 

is 

underlying_terminal: Device_Defs. device; 
new_window_info: Window_Services.window_style_info; 
window_attributes: Terminal_Defs.window_attr := 
Terminal_Def s . def ault_window_attr; 

begin 

— Create new window from old opened window. 
old_window := Character_Display_AM.Ops. 

Get_device_object (Process_Mgt .Get_process_globals_entry ( 
Process_Mgt_Types.standard_input) ) ; 
underlying_terminal := Window_Services.Ops. 

Get_terminal (old_window) ; 
edit_window := Window_Services.Ops.Create_window ( 

terminal => underlying terminal. 
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845 pixel_units => false, 

846 fb_size ■> Terminal_Defs.point_info' { 

847 last_column, frame_rows) , 

848 desired_window_size => Terminal_Defs.point_info' { 

849 last_column, preferred_window_rows) , 

850 window_jpos => origin, 

851 view_pos => origin) ; 

852 — Set window's input and output attributes 

853 — change from default: 

854 window_attributes.enable_signal := false; — for A C A B 

855 window_attributes.line_editing := false; — for A H 

856 window_attributes.echo := false; 

857 — • NOTE: track_cursor NYI (use user agent to change view) 

858 window_attributes.track_cursor :== true; 

859 Window_Services . Ops . Set_window_attr ( 

860 window => edit_window, 

861 attr => window_attributes, 

862 attr_mask -> (others => true)); 

863 — Set Title and Info lines 

864 Text_Mgt. Set (new_window_info. title, file_name) ; 
8 65 Window_Services . Ops . Set_window = sty le ( 

866 window -> edit_window, 

867 new_info => new_window_info, 

868 style_list => (others => true)); 
869 

870 — Open the edit window 

871 open_edit_window := Character_Di splay_AM. Ops. Open ( 

872 device => edit_window, 

873 input_output => Device_Defs.inout, 

874 exclusive => true) ; 
875 

876 — Clear window on terminal screen. 

877 Character_Display _AM. Ops. Clear (open_edit_window) ; 
878 

879 — Write from edit buffer to frame buffer. 

880 — NOTE: There cannot be more line_feeds in the length 

881 — of characters written than there are rows in 

882 — the frame buffer, otherwise some of the first 

883 — characters will be overwritten in the frame buffer 

884 — The last line is written up to the line feed to 

885 — avoid having a blank line at bottom of the window 

886 Character_Display_AM. Ops. Write ( 

887 opened_dev => open_edit_window, 

888 buffer_VA => edit_buffer. lines' address, 

889 length => System. ordinal ( (last_column * (frame_rows - 1) ) 

890 + (Last_char_in_row(frame_end) - 1))); 
891 

892 

893 — Home the cursor (1,1 position). 

894 Character_Display_AM.Ops.Move_cursor_absolute ( 

895 opened_dev => open_edit_window, 

896 new_pos => origin); 
897 

898 Window_Services. Ops. Trans fer_input_focus ( 

899 source_window => old_window, 

900 target_window => edit_window) ; 
901 

902 end Make_window; 

903 

904 

905 

906 HANDLE INPUT 

907 ■ 

908 procedure Handle_input 
909 

910 is 
911 

912 event_num: System. ordinal; 

913 event_type: Terminal_Defs.input_enum; 

914 char_buffer_AD: char_array_AD := new char_array' (others => ' '); 
915 

916 begin 
917 

918 — Enter the basic read and process loop 

919 loop 

920 — Read the next input event 

921 — default input mask is keyboard 
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Character_Display_AM. Ops. Read ( 

opened_dev => open_edit_window, 
buffer_VA => char_buffer_AD. all' address, 
max_events => 1, 
max_bytes => 0, 
block => true, 
type_read => event_type, 
num_read => event_num) ; 
case event_type is 

when Terminal_Defs. keyboard => 

key_input (char_buf fer_AD (1) ) ; 
when Terminal_Defs.menu_item_picked => 

key_input (char_buf fer_AD (1) ) ; 
when others => 
null; 
end case; 
end loop; 
end Handle_input; 



IS PRINTABLE 

function Is_printable (c: character) 
return boolean 

— Logic: 

— Checks if character entered in printable 

is 
begin 

if c >= ' ' or c = ASCII. LF then return true; 
else return false; 
end if; 

end Is_printable; 

pragma inline (Is_printable) ; 

KEY INPUT 

procedure Key_input (key: character) 



result: boolean := true; 
cursor_pos: Terminal_Defs.point_info; 
begin 

— Process the event 
case key is 

when ASCI LACK => 

result := Move_forward; 
when ASCII. STX => 

result := Move_back; 
when ASCII. DLE => 

result := Move_up; 
when ASCII. SO => 

result := Move_down; 
when ASCII.NAK => 

result := Move_Page (-1) ; 
when ASCII. SYN => 

result := Move_page (+1) ; 
when ASCII. EOT => 

result := Delete_forward; 

saved := false; 
when ASCII. BS => 

result := Delete_backward; 

saved := false; 
when ASCII. ETB => 

Save_file; 

saved := true; 
when ASCII. ETX => 

Quit_editor; 
when others => 
— Insert text, 
if Is_printable (key) then 



— Control F 

— Control B 

— Control P 

— Control N 

— Control U 

— Control V 

— Control D 

— Control H 

— Control W 

— Control C 
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result := Insert (key); 
saved := false; 
else Character_Display_AM.Ops.Ring_bell (open_edit_window) 
end if; 
end case; 
if not result then 

Character_Display_AM.Ops.Ring_bell (open_edit_window) ; 
end if; 

— cursor check 
cursor_jpos := Character_Display_AM.Ops.Get_cursor_jposition ( 

open_edit_window) ; 
if edit__buf_pos.row /= frame_begin + (cursorjpos.vert - 1) or 
edit_buf_pos. column /= cursor_pos.horiz then 
RAISE editor_error; 
end if; 

exception 

when editor_error => 

Message_Services.Write_msg (editor_error_code) ; 
return; 

end Key_input; 

end Simple_Editor_Ex; 
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1 with Direct ory_Mgt, 

2 File_Defs, 

3 Passive_Store_Mgt, 

4 Process_Mgt, 

5 Process_Mgt_Types, 

6 Simple_File_Admin, 

7 System_Defs, 

8 Text_Mgt; 
9 

10 procedure Stream_file_ex is 
11 

12 — Function: 

13 — Provide example calls for stream files. 
14 

15 filename: System_Defs.text (60) ; 

16 filel: ' File_Defs. file_AD; 

17 file2: File_Defs.file_AD; 

18 file3: File_Defs.file_AD; 

19 begin 

20 Text_Mgt. Set (filename, "n^file^") ; 

21 filel := Simple_File_Admin.Create_file (filename) ; 

22 — Creates a stream file in the current 

23 — directory. 
24 

25 — Code to write something into the file 

26 — could go here. 
27 

28 Text_Mgt. Set (filename, M my_file_2") ; 

29 file2 := Simple_File_Admin.Create_file (filename) ; 

30 Simple_File_Admin.Copy_file (source_file => filel, 

31 target_file => file2); 

32 — Creates a second file in the current directory, 

33 — and then copies the contents of the first file 

34 — to the second. 
35 

36 Simple_File_Admin.Empty_file (filel) ; 

37 — Empties the first file. 
38 

39 Text_Mgt. Set (filename, ,, my_file_2") ; 

40 Directory_Mgt .Delete (filename) ; 

41 — The second file's pathname is deleted. The 

42 — second file is destroyed when the last 

43 — reference to it goes away. 
44 

45 file2 := Simple_file_Admin.Create_unnamed_file ( 

4 6 Passive_Store_Mgt . Home_volume_set ( 

47 Process_Mgt .Get_process_globals_entry ( 

48 Process_Mgt_Types.current_dir) ) ) ; 

49 — Creates a temporary file in the current 

50 — directory using the current directory's 

51 — volume set. 
52 

53 Text_Mgt. Set (filename, "my_local_name") ; 

54 Simple_File_Admin . Save_unnamed_f ile ( 

55 name => filename, 

56 file => file2) ; 

57 — Names and saves the temporary file so that it 

58 — can be used in future jobs. 
59 

60 file3 := Simple_file_Admin.Create_unnamed_file ( 

61 Passive_Store_Mgt.Home_volume_set ( 

62 Process_Mgt . Get_process_globals_entry ( 

63 Process_Mgt_Types . current_dir) ) ) ; 

64 — Creates another temporary file in the current 

65 — directory. 
66 

67 Simple_File_Admin.Destroy_file(file3) ; 

68 — Destroys the temporary file before its job 

69 — terminates. If it is not destroyed or saved, 

70 — it goes away when the job terminates. 
71 

72 end Stream file ex; 
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X-A-104 Ada Examples 
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X-A.5.1 Inventory_main Procedure 



1 with Character_Display_AM, 

2 Device_Defs, 

3 Incident_Defs, 

4 Inventory_Files, 

5 Inventory_Menus, 

6 Invent ory_Messages, 

7 Invent ory_Windows, 

8 Message_Services, 

9 System, 

10 Terminal_Defs; 

11 

12 

13 — Function: 

14 — Main (top-level) procedure for Inventory 

15 — Example Program. 
16 

17 — The procedure w Inventory_main" is called from 

18 — CLEX. ™Inventory_main" performs the top-level 

19 — processing for the Inventory Example Program: 

20 — program initialization, main processing loop, 

21 — and termination. 
22 

23 — History: 

24 — 05-20-87, William A. Rohm: Written. 

25 ~ 10-27-87, WAR: Revised. 
26 

27 — End of Header 

28 

29 procedure Invent ory_main 

30 

31 — Logic: 

32 — 1. Define incident codes. 

33 — 2. Open windows and files. 

34 — 3. Install and enable menu group, enable menu 

35 — selection 

36 — 4. Process each menu selection until Exit 

37 — 5. Close files and windows. 

38 is 
39 

40 — Incident codes for messages: 
41 

42 module: constant := 1; 

43 — Message module index number. 
44 

45 — *M* set. language : language = English 

46 — *M* create. variable module :value = 1 
47 

48 

49 welcome_code: constant 

50 Incident_Defs.incident_code := ( 

51 message_object => 

52 Inventory_Messages.message_object, 

53 module => module, 

54 number => 0, 

55 severity => Incident_Defs. information) 
3 6 

57 — *M* store : module = $module : number = 0\ 

58 — *M* :msg_name = welcome \ 

59 — *M* : short = "Welcome to the Inventory 

60 — *M* Example Program. '* 
61 

62 

63 terminated_code : constant 

64 Incident_Defs.incident_code := ( 

65 message_object => 

66 Inventory_Messages.message_object, 

67 module => module, 

68 number => 1, 

69 severity => Incident Defs. information) , 
70 

71 — *M* store :module = $module : number = 1\ 

72 — *M* :msg_name = terminated \ 

73 — *M* : short = "Inventory Example Program 

74 — * M * terminated." 
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— Variables: 

menu_select : Terminal_Def s.menu_selection; 
■ — Menu selection record for receiving user 

— input from "Character_Display_AM. Ops. Read". 

— Contains user' s menu group, menu, and item 

— selection numbers. 

event_type : Terminal_Def s . input_enum; 

— Type of user input event (returned from 

— "Character_Display_AM. Ops. Read") . 

event_num: System. ordinal; 

— Number of user input events (returned from 

— "Character_Display_AM. Ops. Read") . 



- Invent ory_main procedure: 
begin 

— Open both main and message windows: 
Inventory _Windows . Open_program_windows; 

— Display "Welcome" message: 

Message_Services.Write_msg( 
msg_id => welcome_code) ; 

— Open files: 

Inventory _Files.Open_parts_file; 
Inventory _Files . Open_log_f ile; 

— Retrieve and install menu group: 
Inventory _Menus . Set_up_menu_group; 



— Set input event type mask for menu item selection 

— only: 

Character_Display_AM. Ops . Set_input_type_mask ( 

opened_dev => Inventory_Windows.main_window, 
new_mask => Terminal_Defs.input_type_mask' ( 
Terminal_Defs.menu_item_picked => true, 
others => false) ) ; 



— Main processing loop: 
loop 

— Wait for and read next input event (must have 

— been a menu selection) : 

Character_Di splay _AM. Ops. Read ( 

opened_dev => Inventory_Windows.main_window, 

buffer_VA => menu_select' address, 

max_events => 1, 

max_bytes => 0, 

block => true, — Wait . . . 

type_read => event_type, 

num_read => event_num) ; 

— Act on menu selection: 
case menu select. menu is 
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153 when Inventory_Menus.inquiry_menu_ID => 

154 Invent ory_Menus .Process_inquiry_menu ( 

155 selection => menu_select . item) ; 
156 

157 when Inventory_Menus.postlng_menu_ID => 

158 Inventory_Menus.Process_posting_menu ( 

159 selection => menu_select . item) ; 
160 

161 when Inventory _Menus.update_menu_ID => 

1 62 Inventory _Menus . Process_update_menu ( 

163 selection => menu_select.item) ; 
164 

165 when Inventory _Menus . report_menu_ID => 

166 Inventory_Menus.Process_report_menu ( 

167 selection => menu_select.item) ; 
168 

169 when Invent ory_Menus.housekeeping_menu_ID => 

170 Inventory_Menus.Process_housekeeping_menu ( 

171 selection => menu_select . item) ; 
172 

173 when Inventory_Menus.exit_menu_ID => 

174 EXIT; 
175 

176 when others => 

177 null; 
178 

179 end case; — "case menu select. menu is™ 

180 

181 end loop; 

182 

183 

184 — Close files: 

185 

186 Inventory_Files.Close_parts_file; 

187 

188 Inventory_Files.Close_log_file; 

189 

190 

191 — Write "terminated" message: 

192 

193 Message_Services.Write_msg( 

194 msg_id => terminated_code) ; 
195 

196 

197 — Close both program windows. When the main 

198 — window is closed, the menu group is deallocated: 
199 

200 Inventory_Windows.Close_program_windows; 

201 

202 end Inventory _main; 

203 

204 
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X-A.5.2 inventory Files Package Specification 



1 with Device_Defs, 

2 Incident_Defs, 

3 Inventory_Messages, 

4 System, 

5 System_Defs, 

6 Timing_Conversions; 
7 

8 package Invent ory_Files is 
9 

10 ■ — Function: 

11 — Contains all operations related to 

12 — Inventory Program files. 
13 

14 — This package contains the necessary calls 

15 — to open and close the two inventory files 

16 — (parts file and log file), and calls to 

17 — read and write records in the parts file, 

18 — and to write records to the log file. 
19 

20 -- History: 

21 ~ 05-20-87, William A. Rohm: Written. 

22 — 11-02-87, WAR: Revised. 
23 

24 — End of Header 

25 

26 — Incident codes for messages: 

27 

28 module: constant := 3; 

29 — Message module index. 
30 

31 — *M* set. language :language=english 

32 — *M* create. variable module : value = 3 
33 

34 no_modify_rights_code: constant 

35 Incident_Defs.incident_code := ( 

36 message_object => 

37 Inventory _Messages.message_object, 

38 module => module, 

39 number => 1, 

40 severity => Incident_Def s. error ) ; 
41 

42 

43 — *m* store : module = $module \ 

44 — *M* : number - 1 \ 

45 — *M* :msg_name = no_mod_rights \ 

46 — *M* : short = "No modify rights for 

47 — * M * parts file '$pl<parts file 

48 — *M* name>'." 
49 

50 
51 

52 no_parts_file_code: constant 

53 Incident_Defs.incident_code := ( 

54 message_object => 

55 Inventory _Messages.message_object, 

56 module -> module, 

57 number => 2, 

58 severity => Incident_Defs. error) ; 
59 

60 — *M* store 

61 — *M* 

62 — - ^j*!^ 

63 — *M* 



module = $module \ 

number = 2 \ 

msg_name = no_parts_file \ 

short = "Parts file , $pl<parts 



64 — *M* file name>' does not 

65 __* M * exist." 
66 

67 

68 no_log_file_code: constant 

69 Incident_Defs.incident_code := { 

70 message_object => 

71 Inventory_Messages.message_object, 

72 module => module, 

73 number => 3, 

74 severity => Incident Defs. error), 
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— *M* store : module = $module \ 

— *M* : number = 3 \ 

— *M* :msg_name = no_log_file \ 

— *M* : short = "Log file '$pl<log 

— *M* file name>' does not 

~*M* exist." 



index_inconsistent_code: constant 
Incident_Defs.incident_code := ( 
message_object => 

Invent ory_Messages.message_object, 
module => module, 
number => 4, 
severity => Incident_Def s. error) ; 

— *M* store : module = $module \ 



-*M* 
-*M* 
-*M* 

-*M* 
-*M* 
-* M * 
-*M* 



: number = 4 \ 

:msg_name = \ 

index_inconsistent \ 

: short - "Parts file 

'$pl<parts file name>' index 
is inconsistent and must be 
redone. Select the 
Housekeeping Menu's item 
'Index Parts File'." 



not_on_file_code: constant 

Incident_Defs.incident_code : = ( 
message_object => 

Inventory_Messages ,message_ob ject , 
module => module, 
number => 5, 
severity => Incident_Defs. error) 

— *M* store : module = $module \ 

— *M* : number = 5 \ 

— *M* :msg_name = not_on_file \ 

— *M* : short = "There is no parts 

— *M* record for part ID '$pl<part 

— *M* ID (index value) >' does not 

— *M* exist." 

not_on_file: exception; 

pragma exception_value (not_on_f ile, 

not_on_f ile_code) ; 

— Raised by "Read_parts_record" and 

— "Rewrite_parts_record" . 



invalid_part_ID_code: constant 

Incident_Defs.incident_code := ( 
message_object => 

Inventory _Me s sages. me ssage_ob ject, 
module => module, 
number => 6, 
severity => Incident_Defs. error) 

— *M* store : module = $module \ 

— *M* : number = 6 \ 

— *M* :msg_name = invalid_part_ID \ 

— *M* : short = "An invalid part ID, 

~*M* % $pl<part ID (index 

— *M* value) >', was entered." 

invalid_part_ID: exception; 

pragma except ion_value (invalid_part_ID, 

invalid__part_ID_code) 

— Raised by "Read_parts_record", 

— "Write_parts_record", and 

— "Rewrite_j?arts_record". 



already_on_file_code: constant 

Incident De?s. incident code := ( 
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message_object => 

Inventory_Messages . message_ob ject , 
module => module, 
number => 7, 
severity =»> Incident_Def s. error ) ; 

— *M* store : module = $module \ 

— *M* : number = 7 \ 

— *M* :msg_name - already_on_file \ 

— *M* : short «=■ "Parts record for part 

— *M* ID »$pl<part ID (index 

— *M* value) >' already exists. 

— *M* Either choose a new part ID, 

— *M* or update the current part's 

— *M* record." 

al ready _on_file: exception; 

pragma except ion_value (already_on_f ile, 

already_on_file_code) ; 

— Raised by "Read_jparts_record" and 

— "Write parts record". 



— Constants: 

parts_file_str: constant string := 
"/example/inventory /part s_f ile"; 

— String constant for parts file's 

— pathname. 

parts_f ile_pathname : System_Def s . text ( 
Incident_Defs.txt_length) := ( 
Incident_Def s . txt_length, 
parts_file_str' length, 
parts_file_str) ; 

— Text constant from parts file's pathname 

— string. 
part_ID_index_str: constant string := 

" part_I D_i ndex " ; 

— String constant for parts file's 

— index's name. 

part_ID_index_name : Sy stem_Def s . text ( 
part_ID_index_str' length) : = ( 
part_ID_index_str' length, 
part_ID_index_str' length, 
part_ID_index_str) ; 

— Text constant from parts file's index's 

— name string. 

log_file_str: constant string := 
" /example/invent ory/log_f ile"; 

— String constant for log file's 

— pathname. 

log_file_pathname: System_Defs.text ( 
Incident_Defs.txt_length) := { 
Incident_Def s . txt_length, 
log_f ile_str' length, 
log_file_str) ; 

— Text constant from log file's pathname 

— string. 



— Variables: 

part s_f ile: Device_Defs.opened_device; 
— ~AD to inventory parts file. 

log_file: Device_Defs.opened_device; 
— AD to inventory log file. 
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— Constants: 

part_ID_length : 

desc_length: 

unit_length: 

loc_length: 

status_length : 

max_suppliers : 

supplier_ID_length: 

qty_digits: 



constant integer :■ Incident_Defs.txt_length; 

constant integer := 30; 

constant integer := 4 

constant integer := 12 

constant integer := 7 

constant integer := 3 

constant integer := 10 

constant integer := 7; 



— Types: 

subtype part_ID_type is System_Defs.text ( 
part_ID_length) ; 

subtype supplier_ID_type is System_Defs.text ( 
supplier_ID_length) ; 

subtype location_type is System_Defs.text ( 
loc_length) ; 

-type qty_type is digits qty_digits; 
subtype qty_type is System. ordinal 
range 0. . 9_999_999; 

-type cost_type is delta 0.01 

range 0.0 .. 99_999_999. 99; 
subtype cost_type is float 

range 0.0. .99_999_999. 99; 

type supplier_array_type is 

array (1. .max_suppliers) of supplier_ID_type; 

— Array of supplier IDs. 

type parts_record_type is 

— Record declaration for parts file 

— records, 
record 

part_ID: part_ID_type; 

— Part identification code (ID). 
desc: System_Defs.text ( 

desc_length) ; 

— Description of part. 

unit : System_Def s . text ( 

unit_length) ; 

— Unit of measure, 
location: location__type; 

~ Warehouse location of part. 
qty_on_hand: qty_type; 
reorder_jpoint: qty_type; 
reorder_qty: qty_type; 
suppliers: supplier_array_type; 

— Array of suppliers for this part. 
usage_this_month: qty_type; 
usage_last_month: qty_type; 
usage_last_year: qty_type; 
avg_unit_cost: cost_type; 
last_unit_cost: cost_type; 

date_f irst_act : 

Timing_Conversions.numeric_time; 

— Date and time of first activity with 

— this part (entered into parts file) . 
date_last_act : 

Timing_Conversions.numeric_time; 

— Date and time of last activity with 

— this part. 

status: SystemJDefs.text ( 

status_length) ; 

— Status of this part ("on order", "on 
— hold", "obsolete", ...). 

end record; 
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Inventory Log File Record Definition 



— Constants: 

doc_length: 
job_length: 

— Types: 



constant integer := 12; 
constant integer := 32; 



type action_type is ( 
create, 

— Create new parts record 
update, 

— Update parts record 
delete, 

— Delete parts record 
receipt, 

issue, 
returns, 
spoilage, 
journal) ; 



type log_record_type is 

— Record declaration for log file records, 
record 

part_ID; part_ID_Lype; 

— Part ID used in current action, 
action: action_type; 

— Action performed with this part ID. 
time: 

Timing_Conversions.numeric_time; 

— Date and time of action. 
doc_number: SystemJDefs.text ( 

doc_length) ; 

— Supplier's document number, 
qty: Qty_type; 

— Taken from 

— "parts_file_record.qty_on_hand" . 
job_ID : System_Def s . text ( 

job_length) ; 

— ID of job which called Inventory 

— Example Program to perform action. 
supplier_ID: supplier_ID_type; 

— ID of supplier for this part and 

— action, 
end record; 



Parts file procedures: 

Open / Read / Write / Rewrite / Close file 



procedure Open_parts_file; 

— Function: 

Opens inventory parts file. 



procedure Read_parts_record( 

part_ID: part_ID_type; 

— Part ID of record to be read. 
msg on error: boolean : = false; 

— Optional parameter specifying whether 

— a message is displayed when an 

— ■ exception is raised. Default is no 

— message. 

parts_record: out parts_record_type) ; 

— Variable that receives parts record. 

— Function: 

Reads a record from the inventory parts 
file. 

— Exceptions: 

not_on_file - **part_ID" does not index 
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an existing parts record. 
invalid_part_ID - "part_ID" contains an 
invalid value. 



procedure Write_parts_record( 

parts_record: parts_record_type) ; 
— Record to be written. 

— Function: 

Writes a record to the inventory parts 
file. 

— Exceptions: 

al ready _on_file - "part_ID" indexes 

an existing parts record. 

invalid_part_ID - "part_ID" contains an 
invalid value. 



procedure Rewrite_parts_record{ 

parts_record: parts_record_type) ; 
— Record to be rewritten. 

— Function: 

Rewrites a record in the inventory 
parts file. 

— Exceptions: 

not_on_file - "part_ID" does not index 

— an existing parts record. 
invalid_part_ID - "part_ID" contains an 

— invalid value. 



procedure Delete_parts_record ( 
part_ID: part_ID_type) ; 

— ID of record to be deleted. 

— Function: 

Deletes a record in the inventory parts file. 

— Exceptions: 

not_on_file - "part_ID" does not index 

— an existing parts record. 
invalid_part_ID - "part_ID" contains an 

— invalid value. 



procedure Close_parts_file; 

— Function: 

Closes inventory parts file. 



Log file procedures: 

Open / Write / Close log file 



procedure Open_log_file; 

— Function: 

— Opens inventory log file. 



procedure Write_log_record ( 

parts_record: parts_record_type; 

— Affected parts record, 
action: action_type) ; 

— Action taken with parts record. 

— Function: 

— Creates and writes a record to the inventory 
log file. 



procedure Close log_file; 
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460 

461 — Function: 

462 — Closes inventory log file. 
463 

464 end Inventory_Files; 
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X-A.5.3 Inventory Files Package Body 



1 with Access_Mgt, 

2 Device_Defs, 

3 Di rectory _Mgt, 

4 Incident_Defs, 

5 Inventory_Windows, 

6 Message_Services, 

7 Me s sage_St ackJMgt , 

8 Object_Mgt, 

9 Record_AM, 

10 System, 

11 SystemJDefs, 

12 System_Exceptions, 

13 Timed_Requests_Mgt, 

14 Timing_Conversions, 

15 Unchecked_conversion; 
16 

17 

18 package body Invent ory_Files is 

19 

20 — Function: 

21 — Contains all operations related to Inventory 

22 — Program files. 
23 

24 — History: 

25 — 05-20-87, William A. Rohm: Written. 

26 — 10-27-87, WAR: Revised. 
27 

28 — End of Header 

29 

30 

31 — Generic function: 

32 — 

33 function Device_from_untyped_word is new 

34 Unchecked_conversion ( 

35 source => System.untyped_word, 

36 target => Device_Def s. device) ; 
37 

38 

39 — Parts file procedures: 

40 — Open / Read / Write / Rewrite / Close parts file 
41 

42 procedure Open_parts_file 

43 is 

44 parts_file_AD: System. untyped_word; 
45 

46 begin 

47 

48 — Retrieve parts file, if possible: 

49 

50 parts_file_AD := Directory _Mgt .Retrieve ( 

51 name => parts_file_pathname) ; 
52 

53 — Check for access (modify) rights for parts file: 
54 

55 if not Access_Mgt. Permits ( 

56 AD => parts_file_AD, 

57 rights => Object_Mgt.modify_rights) 

58 then 

59 Message_Services.Write_msg( 

60 msg_id => no_modify_rights_code, 

61 paraml => Incident_Def s.message_parameter { 

62 typ => Incident_Defs.txt, 

63 len => parts_file_pathname. length) ' ( 

64 typ => Incident_Defs.txt, 

65 len => parts_file_pathname. length, 

66 txt_val => parts_file_pathname) ) ; 

67 end if; 

68 — Open parts file: 
69 

70 parts_file := Record_AM. Ops. Open { 

71 dev => Device_f rom_untyped_word { 

72 parts_file_AD) , 

73 input_output => Device_Defs.inout, 

74 allow => Device Defs. readers) ; 
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75 

76 exception 

77 — Exceptions from "Directory _Mgt .Retrieve", 

78 — "Record_AM. Ops. Open" : 

79 — I 

80 when others => ^ 

81 Message_Services.Write_msg( 

82 msg_id => no_parts_file_code, 

83 paraml => Incident_Defs.message_parameter ( 

84 typ => Incident_Defs.txt, 

85 len => parts_file_pathname. length) ' ( 

86 typ => Incident_Defs.txt, 

87 len => parts_file_pathname. length, 

88 txt_val => parts_file_pathname) ) ; 
89 

90 end Open_parts_file; 

91 

92 

93 procedure Read_parts_record( 

94 part_ID: part_ID_type; 

95 msg_on_error: boolean := false; 

96 parts_record: out parts_record_type) 

97 is 

98 bytes_read: System. ordinal; 
99 

100 use System; — To import "/=" for 

101 — "System. ordinal", and division for 

102 — '"size/8" constructions 
103 

104 begin 

105 

10 6 — Read given record, if any: 

107 

108 bytes_read := Record_AM.Keyed_Ops.Read_by_key ( 

109 opened_dev => parts_file, 

110 buffer_VA => parts_record' address, 

111 length => parts_record' size/8, 

112 index => part_ID_index_name, 

113 key_buffer => Record_AM.key_value_descr' ( 

114 buffer_VA => part_ID' address, 

115 length => part_ID' size/8) ) ; \ 
116 

117 — if bytes_read /= parts_record' size/8 then 

118 — — msg "Couldn't get record" 

119 -- end if; 
120 

121 exception 

122 

123 when Record_AM. invalid_record_address => 

124 

125 if msg_on_error then 

126 Message_Services.Write_msg( 

127 msg_id -> riot_on_file_code, 

128 paraml => Incident_Def s.message_parameter ( 

129 typ => Incident_Defs.txt, 

130 len => part_ID. length) ' ( 

131 typ => Incident_Defs.txt, 

132 len => part_ID. length, 

133 txt_val => part_ID)); 

134 Message_Stack_Mgt .Push_msg_l_param ( 

135 not_on_file_code) ; 

136 end if; 
137 

138 RAISE not_on_file; 

139 

140 when Record_AM.key_value_incomplete => 

141 

142 if msg_on_error then 

143 Message_Services.Write_msg{ 

144 msg_id => invalid_part_ID_code, 

145 paraml => Incident_Defs.message_parameter ( 

146 typ => Incident_Defs.txt, 

147 len => part_ID. length) ' ( 

148 typ => Incident_Defs.txt, 

149 len => part_ID. length, 

150 txt_val => part_ID)); ( 

151 Message_Stack_Mgt . Clear_messages; 
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Message_Stack_Mgt .Push_msg_l_param ( 

message_id => invalid_part_ID_code, 
paraml => Incident_Defs.message_parameter ( 
typ => Incident_Defs.txt, 
len => part__ID. length) ' ( 

typ => Incident_Defs.txt, , 
len => part_ID. length, 
txt_val => part_ID) ) ; 
end if; 

RAISE invalid_part_ID; 



when Record_AM. index_inconsi stent => 

Message_Services . Write_msg ( 

msg_id => index_inconsistent_code, 
paraml => Incident_Defs.message_parameter ( 
typ => Incident_Defs.txt, 
len => parts_file_pathname. length) ' ( 
typ => Incident_Defs.txt, 
len => part s_file_pathname. length, 
txt_val => parts_file_pathname) ) ; 

when others => 
RAISE; 



end Read_parts_record; 



procedure Write_parts_record( 

parts_record: parts_record_type) 

is 

use System; — For "'size/8" constructions 

begin 

— Write (insert in index key sequence) new record 

— into parts file: 

Record_AM. Ops. Insert ( 

opened_dev => parts_file, 
buffer_VA => parts_record' address, 
length => parts_record' size/8) ; 

exception 

when Record_AM.invalid_duplicate => 
RAISE already_on_file; 

when Record_AM.invalid_record_address I 
Record_AM.key_value_incomplete => 
RAISE invalid_part_ID; 

when Record_AM.index_inconsi stent => 
Message_Services.Write_msg( 

msg_id => index_inconsistent_code, 
paraml => Incident_Defs.message_parameter ( 
typ => Incident_Defs.txt, 
len => parts_file_pathname. length) ' ( 
typ => Incident_Defs.txt, 
len => parts_file_pathname. length, 
txt_val => parts_file_pathname) ) ; 

when others => 
RAISE; 

end Write parts record; 



procedure Rewrite_parts_record( 

parts_record: parts_record_type) 

is 



use System; 
begin 



— for '"size/8" constructions 
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229 

230 

231 — Rewrite (update) parts record: 

232 

233 Record_AM.Keyed_Ops.Update_by_key( 

234 opened_dev => parts_file, 

235 buffer_VA => parts_record' address, 

236 length => parts_record' size/8, 

237 index => part_ID_index_name) ; 
238 

239 exception 
240 

241 when Record_AM.invalid_record_address => 

242 Message_Services.Write_msg( 

243 msg_id => not_on_file_code, 

244 paraml => Inciden^Defs.message^ parameter ( 

245 typ => Incident_Defs.txt, 

246 len => part_ID_index_str. length) ' ( 

247 typ => Incident_Defs.txt, 

248 len => part_ID_index_str. length, 
24 9 txt_val -> part_ID_index_name) ) ; 
250 RAISE not_on_file; 

251 

252 when Record_AM.key_yalue_incomplete => 

253 RAISE invalid_part_ID; 
254 

255 when Record_AM.index_inconsistent => 

256 Message_Services=Write_msg( 

257 msg_id => index_inconsistent_code, 

258 paraml => Incident_Defs.message_parameter ( 

259 typ => Incident_Defs.txt, 

260 len => part s_file_pathname. length) ' ( 

261 typ => Incident_Defs.txt, 

262 len => parts_file_pathname. length, 

263 txt_val => parts_file_pathname) ) ; 
264 

265 when others => 

266 RAISE; 
267 

268 end Rewrite_parts_record; 

269 

270 

271 procedure Delete_parts_record( 

272 part_ID: part_ID_type) 

273 is 
274 

275 use System; — for '"size/8" constructions 

276 

277 begin 

278 

279 — Delete parts record: 

280 

281 Record_AM.Keyed_Ops . Delete_by_key ( 

282 opened_dev => parts_file, 

283 index => part_ID_index_name, 

284 key_buffer => Record_AM.key_value_descr' ( 

285 buffer_VA => part_ID' address, 

286 length => part_ID' size/8) ) ; 
287 

288 exception 
289 

290 when Record_AM.invalid_record_address => 

291 RAISE not_on_file; 
292 

293 when Record_AM.key_value_incomplete => 

294 RAISE invalid_part_ID; 
295 

296 when Record_AM.index_inconsi stent => 

297 Message_Services.Write_msg( 

298 msg_id => index_inconsistent_code, 

299 paraml => Incident_Defs.message_parameter ( 

300 typ => Incident_Defs.txt, 

301 len => parts_file_pathname. length) ' ( 

302 typ => Incident_Defs.txt, 

303 len => parts_file_pathname. length, 

304 txt_val => parts_file_pathname) ) ; 
305 
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when others => 
RAISE; 

end Delete parts record; 



procedure Close_parts_file 
Is 

begin 

if Record_AM.Ops.Is_open (parts_file) then 
Record_AM. Ops. Close ( 

opened_dev => parts_file) ; 
end if; 

end Close_parts_file; 



- Log file procedures: 

Open / Write / Close log file 

procedure Open_log_file 
is 

log_file_AD: System. untyped_word; 

begin 

— Retrieve log file, if possible: 

log_file_AD := Directory _Mgt .Retrieve ( 
log_file_pathname) ; 

— Check for access (modify) rights for log file: 

if not Access_Mgt .Permits ( 
AD => log_file_AD, 
rights => Object_Mgt. modify _rights) 
then 

Message_Services.Write_msg ( 

msg_id => no_modify_rights_code, 
paraml => Incident_Defs.message_parameter ( 
typ => Incident_Defs.txt, 
len => log_file_pathname. length) ' ( 
typ => Incident_Defs.txt, 
len => log_file_pathname. length, 
txt_val => log_file_pathname) ) ; 
end if; 

— Open log file: 

log_file : = Record_AM. Ops. Open ( 

dev => Device_from_untyped_word( 

log_file_AD) , 
input_output => Device_Defs.inout, 
allow => Device_Defs. nothing, 
block => false) ; 

exception 

— Exceptions from "Directory _Mgt. Retrieve", 

— "Record_AM. Ops. Open" : 

when others => 

Message_Services . Write_msg ( 

msg_id => no_log_file_code, 
paraml => Incident_Defs.message_parameter ( 
typ => Incident_Defs.txt, 
len => log_file_pathname. length) ' ( 
typ => Incident_Defs.txt, 
len => log_file_pathname. length, 
txt_val => log_file_pathname) ) ; 
end Open log file; 



procedure Write_log_record( 

parts_record: parts_record_type; 
action: action type) 
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383 is 

384 log_record: log_record_type; 
385 

386 use System; — for "'size/8" constructions 

387 

388 begin 

389 

390 log_record.part_ID := parts_record.part_ID; 

391 

392 log_record. action := action; 

393 

394 log_record.time := Timing_Conversions. 

395 Convert_stu_to_numeric_time ( 

396 stu => Timed_Requests_Mgt.Get_time) ; 
397 

398 log_record.doc_number := System_Defs.text (doc_length) ' 

399 (doc_length, 0, (others => ' ')); 
400 

401 log_record.qty := parts_record.qty_on_hand; 
402 

403 log_record. job_ID := Systero_Defs.text ( job_length) ' 

404 (jobJLength, 0, (others => ' ')); 
405 

406 log_record.supplier_ID := 

407 parts_record. suppliers (1) ; 
408 

409 Record_AM.Ops.Set_position ( 

410 opened_dev => log_file, 

411 where -> Record_AM.record_specifier ( 

412 type_of_specifier => Record_AM.last) ' ( 

413 type_of_specifier => Record_AM. last) ) ; 
414 

415 Record_AM.Ops. Insert ( 

416 opened_dev => log_file, 

417 buffer_VA => log_record' address, 

418 length => log_record' size/8) ; 
419 

420 end Write_log_record; 

421 

422 

423 

424 procedure Close_log_file 

425 is 
426 

427 begin 
428 

429 if Record_AM.Ops.Is_open(log_file) then 

430 Record_AM. Ops. Close ( 

431 opened_dev => log_file) ; 

432 end if; 
433 

434 end Close_log_file; 

435 

436 

437 end Inventory_Files; 
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X-A.5.4 inventory_Forms Package Specification 



1 with Device_Defs, 

2 Form_Defs, 

3 Incident_Defs, 

4 Inventory_Files, 

5 Inventory_Messages, 

6 System, 

7 System_Defs, 

8 Terminal_Defs; 
9 

10 package Inventory_Forms is 
11 

12 — Function: 

13 — Contains subprograms to display and process 

14 — Inventory Program forms. 
15 

16 — Includes form handling routines 

17 — ("Process_*x*_form") , a form processing routine 

18 — ("Validate_cost") , and two key-catcher routines 

19 — ("Go_to_inquiry" and "Add_supplier_ID") . 
20 

21 — History: 

22 — 07-06-87, William A. Rohm: Written. 

23 — 11-02-87, WAR: Revised. 
24 

25 — End of Header 

26 

27 — Incident codes for messages: 

28 

2 9 module: constant := 5; 

30 — Message module index. 

31 

32 — *M* set. language : language = English 

33 — *M* create. variable module : value = 5 
34 

35 invalid_output_device_code: constant 

36 Incident_Defs.incident_code := ( 

37 message_ob ject => 

38 Inventory_Messages.message_object, 

39 module => module, 

40 number => 0, 

41 severity => Incident_Def s. error) ; 
42 

43 — *M* store :module = 5 : number = 0\ 

44 — *M* :msg_name = invalid_output_dev\ 

45 — *M* : short = "Entered output device 

46 — *M* pathname , $pl<pathname>' 

47 — *M* does not exist, or does 

48 — *M* not support the record 

49 — *M* access method." 
50 

51 

52 unit_cost_error_code: constant 

53 Incident_Defs.incident_code := ( 

54 message_object => 

55 Inventory_Messages.message_object, 

56 module => module, 

57 number => 1, 

58 severity => Incident_Def s. warning) ; 
59 

60 — *M* store :module = 5 : number = 1\ 

61 — *M* :msg_name = cost_error\ 

62 — *M* : short = "Entered part's unit 

63 — *M* cost is not within 

64 — *M* $pl<allowed variation 

65 — *M* percent age>% of the average 

66 — *M* unit cost. Please re-enter 

67 — *M* $p2<total/unit> cost, or the 

68 — *M* number of units." 
69 

70 

71 — Constants: 

72 

73 inquiry_form_str: constant string := 

74 "/examples/inventory/forms/inquiry"; 
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— String constant for inquiry form' s 

— pathname. 

inquiry _form_pathname : System_Def s . text ( 
inquiry_form_str' length) := ( 
inquiry_f orm_str' length, 
inquiry_f orm_str' length, 
inquiry_f orm_str) ; 

— Text constant from inquiry form's 

— pathname string. 

receipt s_form_str: constant string :=» 

"/examples/ inventory /forms /receipts"; 

— String constant for receipts form's 

— pathname. 

receipt s_form_pathname: System_Defs.text ( 
receipts_form_str' length) := ( 
receipts_form_str' length, 
receipts_form_str' length, 
receipt s_form_str) ; 

— Text constant from receipts form' s 

— pathname string. 

update_form_str: constant string := 

"/examples/ inventory /forms /update"; 

— String constant for update form' s 

— pathname. 

update_form_pathname: System_Defs.text ( 
update_form_str' length) := ( 
update_f orm_str' length, 
update_form_str' length, 
update_form_str) ; 

— Text constant from update form' s 

— pathname string. 

report_form_str: constant string := 

"/examples/ inventory/ forms /report"; 

— String constant for report form's 

— pathname. 

report_form_pathname: System_Def s. text ( 
report_form_str' length) := ( 
report_form_str' length, 
report_f orm_str' length, 
report_form_str) ; 

— Text constant from report form' s 

— pathname string. 



— Field and subform names for forms: 

part_ID_field: System_Defs.text ( 7) 

7.7, "part_ID"); 

desc_field: System_Defs.text (11) 

11, 11, "description") ; 
unit_field: System_Defs. text ( 4) 

4,4, "unit"); 
loc_field: System_Defs.text ( 8) 

8.8, "location"); 

qty_field: System_Def s.text (11) 

11, 11, "qty_on_hand" ) ; 
reorder_pt_field: System_Def s.text (13) 

13, 13, "reorder_point") ; 
reorder_qty_field: System_Def s.text (11) 

11,11, "reorder_qty") ; 
suppliers_field: System_Def s.text ( 9) 

9.9, "suppliers"); 
usage_tmo_field: System_Def s.text (16) 

16,16, "usage_this_month") ; 
usage_lmo_field: System_Def s.text (16) 

16,16, "usage_last_month") ; 
usage_lyr_field: System_Def s.text (15) 

15, 15, "usage_last_year") ; 
avg_cost_field: System_Def s.text (13) 
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13, 13, "avg_unit_cost") ; 
last_cost_field: System_Defs.text (14) := ( 

14,14,"last_unit_cost"); 
date_first_field: System_Defs.text (14) := ( 

14, 14, "date_first_act") ; 
date_last_field: System_Def s.text (13) := ( 

13.13, "date_last_act") ; 
status_field: System_Def s.text ( 6) := ( 

6,6, "status"); 

inq_suppl_ref_field: SystemJDef s.text (19) := ( 

19,19, "supplier_ref_number") ; 
inq_date_field: System_Def s.text ( 4) := ( 

4,4, "date"); 
inq_time_field: System_Defs. text ( 4) := ( 

4,4, "time"); 

rpt_type_field: System_Def s.text (11) := ( 

11, 11, "report_type") ; 
rpt_opt_field: System_Def s.text (14) := ( 

14.14, "report_options") ; 
rpt_dev_field: System_Def s.text (20) := ( 

20, 20, "report output device"); 



— Group and subform names for forms: 

inq_part_ID_only : System_Def s.text (16) 
16,16, "inq_part_ID_only") ; 

inq_all: System_Def s.text (15) 

15, 15, "inq_display_all") ; 

update_add: System_Def s.text (10) 

10,10, "update_add") ; 
update_change: System_Def s.text (13) 

13,13, "update_change") ; 
update_delete: System_Def s.text (13) 

13, 13, "update delete"); 



— Types: 

subtype percentage is System. short_ordinal 
range . . 9 9 ; 

type percentage_range_type is 

— Type for containing percentage range, 
record 

percent__less: percentage; 

— Maximum percent of change less than 

— reference value. 
percent_more: percentage; 

— Maximum percent of change more than 

— reference value. 
end record; 



procedure Process_inquiry_form; 
— Function: 

Processes inquiry form: displays form in 
main window, gets valid information 
("part_ID"), then reads Parts Master File and 
displays parts record. 



procedure Process_receipts_form; 
— Function: 

Processes receipts form: displays form in 
main window, gets valid information 
("part_ID", "supplier", "quantity", etc), 
reads Parts Master File to validate, updates 
parts record, then writes log file record. 
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procedure Process_update_form( 

selection: Terminal_Def s.menu_item_ID) ; 

— Selection made in the "Maintenance" menu; 

— either *Add*, *Change*, or *Delete*. 
— Function: 

Processes update form: displays form in main 
window, gets valid information ("part_ID") , 
reads Parts Master File and displays parts 
record, then updates or deletes part record. 



procedure Process_report_f orm ( 

report_by_part : boolean; 

— True if the report is to be "by part", 

— false if the report is "by location". 
report_out_dev : out System_Defs.text) ; 

— Variable that receives output device 

— pathname where report is to be sent. 

— Function: 

Processes report form: displays form in main 
window, gets report output device. 



— Form processing & key catcher routines: 



procedure Validate_cost ( 
old_parts_record: 

Inventory_Files.parts_record_type; 

— Parts record from file. 
qty_received: 

Inventory_Files . qty_type; 

— Entered quantity received. 
total_cost: in out 

Inventory _Files . cost_type; 

— Entered or calculated total cost. 
unit_cost: in out 

Inventory _Files . cost_type; 

— Entered or calculated unit cost, 
total: boolean := true; 

— Whether to calculate the "total_cost" from 

— the "unit_cost", or vice versa. 

— If true (default) , the "total_cost" is 

— calculated from the given "unit_cost" times 

— the given "qty_received" . If false, the 

— "unit_cost" is calculated by dividing the 

— given "total_cost" by the given 

— "qty_received" . 
percent age_range: 

percentage_range_type := (5, 5); 

— Maximum low and high percentage 

— difference between parts record's 

— "avg_unit_cost" (also required of 

— "last_unit_cost") and the entered or 

— calculated "unit_cost" parameter, 
valid: out boolean) ; 

— Whether the entered or calculated unit cost 

— is within the given "percentage_range" of 

— cost on file. 

— Function: 

Processing routine called from the Receipts 
form to validate unit cost and to calculate and 
return either total cost or unit cost. 



procedure Go_to_inquiry; 

— Function: 

Key catcher called from the "Receipts" or 
"Change" form when the user presses the 
"<Go-to-Inquiry>" key. Calls 
"Process_inquiry_f orm" . 

When this procedure (key-catcher) is activated, 
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306 — the enclosing form has been suspended. When 

307 — this procedure returns, the enclosing form 

308 — continues. 
309 

310 

311 procedure Add_supplier_ID ( 

312 opened_form: Form_Def s.opened_form_AD) ; 

313 — Opened form to which another "supplier_ID" 

314 — field will be added. 
315 

316 — Function: 

317 — Key catcher called from the "Add" form when the 

318 — user presses the "<next>" key. Adds another 

319 — "supplier_ID" field to current form, up to a 

320 — total of three. 
321 

322 end Inventory _Forms; 
323 
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X-A.5.5 Inventory Forms Package Body 



1 with Data_Definition_Mgt, 

2 Device_Defs, 

3 D i re c t o ry_Mgt , 

4 Form_Defs, 

5 Form_Handler, 

6 Inventory_Files, 

7 Invent ory_Menus, 

8 Invent ory_Windows, 

9 Message_Services, 

10 Record_AM, 

11 System, 

12 System_Defs, 

13 Terminal_Defs, 

14 Text_Mgt, 

15 Timed_Requests_Mgt, 

16 Timing_Conversions, 

17 Unchecked_Conversion, 

18 Window_Services; 
19 

20 

21 package body Inventory_Forms is 

22 

23 

24 function Get_form( 

25 form_pathname: System_Defs.text) 

26 return Form_Defs.opened_form_AD 

27 is 
28 

29 — Logic: 

30 — Gets requested form from directory, opens 

31 — form. 
32 

33 — Generic function: 

34 

35 function DDef_from_untyped is new 

3 6 Unchecked_conversion ( 

37 source => System. untyped_word, 

38 target => Data_Definition_Mgt ,DDef_AD) ; 
39 

40 opened_form: Form_Defs.opened_form_AD; 

41 — Returned opened form's AD. 
42 

43 begin 

44 opened_form := Form_Handler.Open_form( 

45 DDef => DDef_from_untyped{ 

4 6 Directory _Mgt .Retrieve ( 
47 name => formjpathname) ) ) ; 
48 

4 9 return opened_form; 

50 

51 end Get_form; 

52 

53 

54 procedure Process_inquiry_form 

55 

56 — Logic: 

57 — 1. Display form in main window 

58 — 2. Get valid information ("part_ID") 

59 — 3. Read Parts Master File and display parts 

60 — record 
61 

62 is 
63 

64 opened_form: Form_Defs.opened_form_AD; 

65 form_status: Form_Defs.status_t; 
66 

67 opened_record_form: Device_Def s.opened_device; 

68 — For record access to "opened_form" . 
69 

70 part_ID: Inventory_Files.part_ID_type; 

71 parts_record: Inventory _Files. part s_record_type; 
72 

73 length: System. ordinal; 

74 empty: boolean; 
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error: 
first_time: 
use Form_Defs; 

use System; 



boolean; 
boolean := true; 

— import "/=" for type 

— "Form_Defs.status_t" 

— for '"size/8" arithmetic 



begin 

opened_form := Get_form(inquiry_form_pathname) ; 

— Open form's DDef for record access: 

opened_record_form := Record_AM.Open_by_name ( 
name => inquiry_form_pathname, 
input_output => Device_Defs.inout) ; 

— Set up first rank (group) in "inquiry form" 

— pile: 

Form_Handler . Create_group_instances ( 

opened_form_a => opened_form, 
group => inq_part_ID_only, 

number_of_instances => 1); 

— Read part ID, display, ask for another: 
loop 

— Get first part ID: 

form_status := Form_Handler.Get ( 

opened_form_a => opened_form, 
opened_window_a => Inventory_Windows. 
main_window) ; 

if form_status /= Form_Defs. finished then 

— some kind of error processing 

null; 

else 

Form_Handler.Fetch_value ( 

opened_form_a => opened_form, 
element => part_ID_field, 

subunit => System_Defs.null_text, 

— added subunit; value correct? 
value_buf fer_VA => part_ID' address, 
value_length => part_ID' size/8, 
value_t => 

Data_Def inition_Mgt . t_string, 
element_value_length => length, 
empty => empty) ; 

if empty then =- user entered null part ID: 
— exit loop; return to menu 
EXIT; 
end if; 

— Read parts file, handle exceptions: 

begin 

Inventory _Files.Read_parts_record ( 
part_ID => part_ID, 
msg_on_error => true, 
parts_record => parts_record) ; 

if first_time then 

— set up other rank 

first_time := false; 

— Remove first group (rank) : 
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Form_Handler . Remove_group_inst ances ( 

opened_form_a => opened_form, 
group => inq_part_ID_only, 

number_of_instances => 1); 

— Add second group (rank) : 

Form_Handler . Create_group_instances ( 

opened_form_a => opened_form, 
group => inq_all, 

number_of_in stances => 1); 

end if; — If "first_time" through 

Record_AM . Ops . Update ( 

opened_dev => opened_record_form, 
buffer_VA => parts_record' address, 
length => parts_record' size/8) ; 

exception 

when Inventory _Files.not_on_file => 

null; — "Record not found" message 

— has been displayed; go 

— through loop again 

when Inventory _Files.invalid_j?art_ID => 
null; — "Invalid part ID entered" 

— message has been displayed; 

— go through loop again 
end; 

end if; — if form status = finished 

end loop; — read part_ID, display loop 

Form_Handler. Clear ( 

opened_form_a => opened_f orm) ; 

Form_Handler . Close_f orm ( 

opened_form_a => opened_form) ; 

— Close record access to form: 

Record_AM. Ops. Close ( 

opened_dev => opened_record_f orm) ; 

end Process_inquiry_form; 



procedure Process_receipts_form 

— Logic: 

1. Display form in main window 

2. Get receipt information ("part_ID", 
"supplier", etc) 

3. Read Parts Master File to validate 

— 4. If valid, update parts record, then write 

— log file record. 



opened_f orm: Form_Def s . opened_f orm_AD; 

form_status: Form_Defs.status_t; 

part_ID: Inventory _Files.part_ID_type; 
parts_record: Inventory_Files.parts_record_type; 

length: System. ordinal; 
empty, error: boolean; 

now: Timing_Conversions.numeric_time; 

use FormJDefs; — import "/=" for type 
— "Form Defs. status t" 
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use System; — for '"size/8" arithmetic 
begin 

opened_form := Get_form(receipts_form_pathname) ; 

loop 

form_status := Form_Handler.Get ( 

opened_form_a => opened_form, 
opened_window_a => Inventory _Windows. 
main_window) ; 

if form_status /- Form_Defs. finished then 

— Some kind of error processing 
null; 

else 



Form_Handler.Fetch_value ( 

opened_form_a => opened_form, 
element => part_ID_field, 

subunit => System_Defs.null_text, 

— added subunit; value correct? 
value_buffer_VA => part_ID' address, 
value_length => part_ID' size/8, 
value_t => 

Data_Definition_Mgt.t_string, 
element_value_length => length, 
empty => empty) ; 

if empty then 

— null part_ID; return to menu 

EXIT; 
end if; 

begin 

Inventory_Files.Read_parts_record { 
part_ID => part_ID, 
msg_on_error => true, 
parts record => parts record) ; 



Form_Handler.Store_value ( 

opened_form_a => opened_form, 

element => desc_field, 

subunit => System_Defs.null_text, 

— added subunit; value correct? 
value_buf fer_VA => 

parts_record.desc' address, 
value_length => 

parts_record.desc' size/8, 
value_t => 

Data_Definition__Mgt .t_string) ; 

Form_Handler . Store_value ( 

opened_form_a => opened_form, 

element => unit_field, 

subunit => System_Defs.null_text, 

— added subunit; value correct? 
value_buffer_VA => 

parts_record.unit' address, 
value_length => 

part s_record. unit' size/8, 
value_t -> 

Data_Def inition_Mgt . t_string) ; 

now := Timing_Conversions. 

Convert_stu_to_numeric_time ( 

stu => Timed_Requests_Mgt .Get_time) ; 

Form_Handler . Store_value ( 

opened form a => opened form. 
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element => inq_date_field, 
subunit => System_Defs.null_text, 

— added subunit; value correct? 
value_buffer_VA => now' address, 
value_length => now' size/8, 
value_t => 

Data_Definition_Mgt .t_date) ; 

Form_Handler . Store_value ( 

opened_form_a => opened_form, 
element => inq_time_field, 
subunit => System_Defs.null_text, 

■ — added subunit; value correct? 
value_buffer_VA => now' address, 
value_length => now' size/8, 
value_t => 

Data_Definition_Mgt.t_date) ; 

exception 

when Inventory _Files.not_on_file => 

null; — "Record not found" message 

— has been displayed; go 

— through loop again 

when Inventory_Files.invalid_part_ID => 
null; — "Invalid part ID entered" 

— message has been displayed; 

— go through loop again 

end; — Read parts record block 

end if; — if form status = finished 

end loop; 

Form_Handler. Clear ( 

opened_form_a => opened_form) ; 

Form_Handler.Close_form( 

opened_form_a => opened_form) ; 

end Process receipts form; 



procedure Process_update_form( 

selection: Terminal_Defs.menu_item_ID) 

— Logic: 

1. Get update form and create appropriate 
subform 

2. Get "part_ID" 

3. Read Parts Master File and display parts 
record 

4. Add, change, or delete part record 

5. Write appropriate log record 



opened_f orm: Form_Def s . opened_f orm_AD; 

— AD to opened "update" form. 

form_status: Form_Defs.status_t; 

part_ID: Inventory _Files.part_ID_type; 

parts_record: 

Inventory_Files.parts_record_type; 
new_part s_record : 

Invent ory_Files. part s_record_type; 
log_record: Inventory_Files. log_record_type; 

opened_record_form: Devi ce_De f s. opened_de vice; 

— For record access to "opened_form" . 

length: System. ordinal; 

— Length of a returned record, in bytes, 
empty: boolean; 
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— Whether the entered "part_ID" field was 

— empty. 

new_part: boolean; 

— True if this is a new part ID (add only!). 



use Form Defs; 



— to import "/=" for 

— Form_Def s.status_t 

— for '"size/8" arithmetic 



use System; 
begin 

— Open "update" form: 

opened_form := Get_form( 
update_f orm_pathname) ; 

— Create appropriate group instance 

— (add, change, delete) : 

case selection is 

when Inventory _Menus.update_add_item => 

Form_Handler.Create_group_instances ( 

opened_form_a => opened_form, 
group => update_add, 

number_of_instances => 1) ; 

when Inventory _Menus.update_change_item => 
Form_Handler . Create_group_instances ( 

opened_form_a => opened_form, 
group => update_change, 

number_of_instances => 1); 

when Inventory _Menus.update_delete_item => 
Form_Handler . Create_group_instances ( 

opened_form_a => opened_form, 
group => update,_delete, 

number_of_instances => 1); 

when others => 
null; 

end case; 

— Open form's DDef for record access: 

opened_record_form := Record_AM.Open_by_name ( 
name => update_form_pathname, 
input_output => Device_Def s.inout) ; 

loop 

— Get a part ID: 

form_status := Form_Handler.Get ( 

opened_form_a => opened_form, 
opened_window_a => 

Inventory _Windows.main_window) ; 

if form_status /= Form_Defs. finished then 

— Some kind of error processing 
null; 

else 

Form_Handler.Fetch_value ( 

opened_form_a => opened_form, 
element => part_ID_field, 

subunit => System_Defs.null_text, 

— added subunit; value correct? 
value_buffer_VA => part_ID' address, 
value_length => part_ID' size/8, 
value_t => 

Data Definition Mgt.t string, 
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element_value_length => length, 
empty => empty) ; 

if empty then 

EXIT; — exit loop 
else 

begin 

— Get parts record, if possible: 

new_part := false; 

Invent ory_Files.Read_parts_record( 
part_ID => part_ID, 
parts_record => parts_record) ; 

Record_AM. Ops . Update ( 

opened_dev => opened_record_form, 
buffer_VA => part s_record' address, 
length => parts_record' size/8) ; 

exception 

when Inventory _Files.not_on_file => 
new_part : = true; 

when Inventory _Files.invalid_part_ID => 
null; — "Invalid part ID 

— entered" message has 

— been displayed; go 

— through loop again 
end; 

case selection is 

when Inventory _Menus.update_add_item => 
if new_part then 

length := Record_AM. Ops. Read ( 

opened_dev => opened_record_form, 
buffer_VA -> parts_record' address, 
length => parts_record' size/8) ; 

Invent ory_Files.Write_parts_record ( 
parts_record => parts_record) ; 

— Create and write log record: 

Inventory _Files.Write_log_record( 
parts_record => parts_record, 
action => 

Inventory _Files. create) ; 

end if; 

when Inventory_Menus.update_change_item => 
length := Record_AM. Ops. Read { 

opened_dev => opened_record_form, 
buffer_VA => 

new_parts_record' address, 
length => 

new_parts_record' size/ 8) ; 

Invent ory_Files.Rewrite_parts_record( 
parts_record => parts_record) ; 

— Create and write log record: 

Inventory _Files.Write_log_record( 
parts_record => parts_record, 
action => 

Inventory _Files. update) ; 

when Inventory _Menus.update_delete_item => 

Inventory _Files.Delete_parts_record ( 
partJED => part_ID) ; 

— Create and write log record: 
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Invent ory_Files.Write_log_record( 
parts_record => parts_record, 
action => 

Inventory_Files. delete) ; 

when others => 
null; 

end case; 

end if; — if not empty part ID 

end if; — if form finished 

end loop; 

Form_Handler . Clear { 

opened_form_a => opened_form) ; 

Form_Handler . Close_f orm ( 

opened_form_a => opened_form) ; 

— Close record access to form: 

Record_AM.Ops .Close ( 

opened_dev => opened_record_form) ; 

end Process_update_form; 



procedure Process_report_form( 

report_by_part : boolean; 

— True if by part, false if by location. 
report_out_dev : out System_Defs. text) 

— Returned output device's pathname, 

— "System_Defs.null_text" if error. 

— Logic: 

1 . Open report form 

2. Get report options and output device 

3. Attempt opening and closing report 
output device 

4. Clear and close form 

5. If any error occurred, return 
"report_out_dev" as "null_text" 



opened_f orm: Form_Def s . opened_f orm_AD; 
form status: Form Defs. status t; 



length: 
empty : 



System. ordinal; 
boolean; 



report_options: System. ordinal; 

— Report options field value. 

valid: boolean; 

— Whether the report information is valid. 

test_out_dev: System_Def s. text (Incident_Def s. txt_length) 

— Entered report output device pathname to be 

— checked. 

test_opened_dev: Device_Def s.opened_device; 

— Opened device returned from 

— "Record_AM.Open" (test to see if 

— entered device pathname is valid) . 



use Form Defs; 



— import "/=" for type 

— "Form_Def s . status_t " 

— for '"size/8" arithmetic 



use System; 
begin 

opened_form := Get_form(report_form_pathname) 
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form_status := Form_Handler.Get ( 

opened_form_a => opened_form, 
opened_window_a => Invent ory_Windows. 
main_window) ; 

if form_status /= Form_Defs. finished then 

— some kind of error processing 

null; 

else 

Form_Handler.Fetch_value ( 

opened_form_a => opened_form, 
element => rpt_type_field, 

subunit => System_Defs.null_text, 

— added subunit; value correct? 
value_buffer_VA -> 

report_by_part' address, 
value_length => report_by_part' size/8, 
value = t => 

Data_Def inition_Mgt . t_boolean, 
element_value_length => length, 
empty => empty) ; 

valid := not empty; 



Form_Handler.Fetch_value ( 

opened_form_a => opened_form, 
element => rpt_opt_field, 

subunit => System_Def s.null_text, 

— added subunit; value correct? 
value_buffer_VA => 

report_options' address, 
value_length => report_options' size/8, 
value_t => 

Data_Definition_Mgt .t_ord4, 
element_value_length => length, 
empty => empty) ; 



valid := valid and (not empty); 

Form_Handler.Fetch_value ( 

opened_form_a => opened_form, 
element => rpt_dev_field, 

subunit => System_Def s.null_text, 

— added subunit; value correct? 
value_buffer_VA => 

test_out_dev' address, 
value_length => test_out_dev' size/8, 
value_t => 

Data_Definition_Mgt .t_string, 
element_value_length -> length, 
empty => empty) ; 

valid := valid and (not empty); 



— Try to open device at the new pathname: 

begin 

test_opened_dev := Record_AM.Open_by_name ( 
name => test_out_dev, 
input_output => Device_Defs. output) ; 

Record_AM. Ops. Close ( 

opened_dev => test_opened_dev) ; 

exception 

when others => 
valid := false; 

Message Services. Write msg( 
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msg_id => invalid_output_device_code, 
paraml => Incident_Defs.message_parameter ( 
typ => Incident_Defs.txt, 
len => test_out_dev. length) ' ( 

typ => Incident_Defs.txt, 
len => test_out_dev. length, 
txt_val => test_out_dev) ) ; 

end; — test open 

end if; — if form status = finished 

Form_Handler . Clear ( 

opened_f orm_a => opened_form) ; 

Form_Handler.Close_form( 

opened_f orm_a => opened_f orm) ; 

if valid then 

report_out_dev := test_out_dev; 
else 

report_out_dev := System_Defs.null_text; 
end if; 

end Process_report_form; 
— Form Processing Routine & Key Catchers: 



procedure Validate_cost ( 
old_parts_record: 

Inventory _Files. parts_record_type; 
qty_received: 

Inventory _Files . qty_type; 
total_cost: in out 

Inventory _Files.cost_type; 
unit_cost: in out 

Inventory _Files.cost_type; 
total: boolean := true; 

percentage_range : 

percentage_range_type := (5, 5); 
valid: out boolean) 

— Logic: 

Called from the Receipts form to validate unit 

— cost and to calculate and return either total 
cost or unit cost. 



max_cost, min_cost: float; 
use System; — to import "*" and "/" 
begin 

— Calculate total or unit cost: 

if total then 

total_cost := float (unit_cost) * 

float (qty_received) ; 
else 

unit_cost := float (total_cost) / 
float (qty_received) ; 
end if; 

— Calculate minimum and maximum acceptable unit 

— costs: 

min_cost := float (old_parts_record. avg_unit_cost) 
(1.0 - float (percentage_range.percent_less) 
/ 100.0); 

max_cost := float (old_parts_record.avg_unit_cost) 
(1.0 + float (percentage_range.percent_less) 
/ 100.0); 
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768 

769 — Check unit_cost against average cost: 

770 

771 valid := (unit_cost >= min_cost) and 

772 (unit_cost <= max_cost); 
773 

774 end Validate_cost; 

775 

776 

777 

778 procedure Go_to_inquiry 

779 

780 — Logic: 

781 — Called from the "Receipts" or "Change" form. 
782 

783 — Calls "Process_inquiry_form" . Enclosing 

784 — (calling) form is suspended during key-catcher 

785 — call, resumed upon return from this procedure. 

786 is 
787 

788 begin 

789 

790 Process_inquiry_form; 

791 

792 end Go_to_inquiry; 

793 

794 

795 procedure Add_supplier_ID ( 

796 opened_form: Form_Def s.opened_form_AD) 
797 

798 — Logic: 

799 — Called from the "Add" form. 
800 

801 — Calls "Process_inquiry_form". Enclosing 

802 — (calling) form is suspended during key-catcher 

803 — call, resumed upon return from this procedure. 

804 is 
805 

806 begin 
807 

808 begin 

809 — Add another instance of the supplier ID group. 

810 Form_Handler.Create_group_instances ( 

811 opened_form_a => opened_form, 

812 group => suppliers_field, 

813 number_of_instances => 1) ; 
814 

815 exception 

816 when Form_Handler.maximum_number_reached => null; 
817 

818 end; 

819 

820 end Add_supplier_ID; 

821 

822 end Inventory_Forms; 

823 
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X-A.5.6 inventory_Menus Package Specification 



1 with Device_Defs, 

2 Incident_Def s, 

3 Inventory_Messages, 

4 System, 

5 System_Defs, 

6 Terminal_Defs, 

7 Window_Services; 
8 

9 package Inventory_Menus is 
10 

11 — Function: 

12 — Contains subprograms to install and process 

13 — Inventory Example Program menus. 
14 

15 — This package contains the routines which 

16 — perform each menu's selection actions. Some of 

17 — the menu selections require calls to the 

18 — "Inventory _Forms" and "Inventory_Reports" 

19 — packages. 
20 

21 — History: 

22 — 05-18-87, William A. Rohm: Written. 

23 — 10-27-87, WAR: Revised. 
24 

25 — End of Header 

26 

27 

28 — Incident codes for messages: 

29 

30 module: constant := 4; 

31 — Message module index. 
32 

33 — *M* set. language : language = English 

34 — *M* create. variable module :value = 4 
35 

36 unable_to_install_code: constant 

37 Incident_Defs.incident_code := ( 

38 message_object => 

39 Inventory _Messages .message_ob ject, 

40 module => module, 

41 number => 0, 

42 severity => 

43 Incident_Def s. error ) ; 
44 

45 — *M* store : module = $module : number = 0\ 

46 — *M* :msg_name = unable_install \ 

47 — *M* : short = "Unable to install menus." 
48 

49 

50 no_selection_code: constant 

51 Incident_Def s.incident_code := ( 

52 message_object => 

53 Inventory _Messages.message_ob ject, 

54 module => module, 

55 number => 1, 

56 severity => 

57 Incident_Def s. warning) ; 
58 

59 — *M* store : module = $module : number = 1\ 

60 — *M* :msg_name = no_selection\ 

61 — *M* : short = "Selection $pl<selection 

62 — *M* number> is not implemented." 
63 

64 

65 menu_group_DDef_path: 

66 System_Defs.text (34) := (34,34, 

67 "/examples/inventory/DDef/menu_DDef ") ; 

68 — Pathname of stored menu group DDef . 
69 

7 menu_group_DDef _root_name : 

71 System_Defs.text (4) := (4, 4, "root") ; 

72 — Pathname of menu group DDef's root node. 
73 

74 inv menu group ID: constant 
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Terminal_Def s . menu_group_ID 
— Inventory menu group's ID. 



:= 1; 



- Menu IDs 
inquiry_menu_ID : 
Terminal_Defs. 

posting_menu_ID : 
Terminal_Def s . 

update_menu_ID : 

Terminal_Defs. 

report_menu_ID : 

Terminal_Def s . 

housekeeping_menu_ 
Terminal_Def s ■ 

exit_menu__ID : 

Terminal Defs, 



constant 
,menu_ID := 1; 

constant 
,menu_ID := 2; 

constant 
,menu_ID := 3; 

constant 
.menu_ID := 4; 

_ID: constant 
,menu_ID := 5; 

constant 
.menu ID := 6; 



- Inquiry menu items 
inq_by_part_item: constant 

Terminal_Def s . menu_item_ID 
inq_by_desc_item: constant 

Terminal_Def s . menu_item_ID 
inq_exit_item: constant 

Terminal Defs. menu item ID 



- Posting menu items 
post_receipt_item: constant 

Terminal_Defs.menu_item_ID 
post_issue_item: constant 

Terminal_Defs.menu_item_ID 
post_return_item: constant 

Terminal_Def s . menu_item_ID 
post_spoilage_item: constant 

Terminal_Def s . menu_i tem_ID 
post_journal_item: constant 

Terminal_Defs.menu_item_ID 
post_exit_item: constant 

Terminal Defs. menu item ID 



- Update menu items 
update_add_item: constant 

Terminal_Def s . menu_item_ID 
update_change_item: constant 

Terminal_Def s . menu_item_ID 
update_delete_item: constant 

Terminal_Def s.menu_item_ID 
update_exit_item: constant 

Terminal Defs. menu item ID 



- Report menu items 
report_by_part_item: constant 

Terminal_Defs.menu_item_ID := 1 
report_by_location_item: constant 

Terminal_Defs.menu_item_ID := 2 
report_exit_item: constant 

Terminal Defs. menu item ID := 3 



- Housekeeping menu items 
hskpg_index_item: constant 

Terminal_Def s .menu_item_ID 
hskpg_exit_item: constant 

Terminal Defs. menu item ID 



procedure Set_up_menu_group; 
— Function: 



:= 1; 
:= 2; 
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152 — Retrieve Inventory Example Program' s menu 

153 — group description (*a menu DDef*), then 

154 — install and enable the menu group in the main 

155 — window. 
156 

157 

158 — Menu selection processing procedures: 

159 — Inquiry / Posting / Update / Report / Housekeeping 

160 — 
161 

162 procedure Process_inquiry_menu ( 

163 selection: Terminal_Defs.menu_item_ID) ; 

164 — Selection made in this menu. 
165 

166 — Function: 

167 — Processes selections from the Inquiry menu. 
168 

169 
170 

171 procedure Process_posting_menu ( 

172 selection: Terminal_Def s.menu_item_ID) ; 

173 — Selection made in this menu. 
174 

175 — Function: 

176 — Processes selections from the Posting menu. 
177 

178 
179 

180 procedure Process_update_menu ( 

181 selection: Terminal_Defs.menu_item_ID) ; 

182 — Selection made in this menu. 
183 

184 — Function: 

185 — Processes selections from the Update menu. 
186 

187 
188 

189 procedure Process_report_menu ( 

190 selection: Terminal_Defs.menu_item_ID) ; 

191 — Selection made in this menu. 
192 

193 — Function: 

194 — Processes selections from the Report menu. 
195 

196 

197 procedure Process_housekeeping_menu ( 

198 selection: Terminal_Def s.menu_item_ID) ; 

199 — Selection made in this menu. 
200 

201 — Function: 

202 — Processes selections from the Housekeeping 

203 — menu. 
204 

205 end Inventory_Menus; 
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X-A.5.7 Inventory_Menus Package Body 



1 with Data_Definition_Mgt, 

2 Device_Defs, 

3 Directory _Mgt, 

4 File_Admin, 

5 File_Defs, 

6 Incident_Defs, 

7 Inventory_Files, 

8 Inventory _Forms, 

9 Inventory_Messages, 

10 Inventory_Reports, 

11 Inventory _Windows, 

12 Message_Services, 

13 Record_AM,- 

14 System_Defs, 

15 Terminal_Defs, 

16 Unchecked_Conversion, 

17 Window_Services; 
18 

19 package body Inventory_Menus is 

20 

21 — Generic function: 

22 

23 function DDef_from_untyped is new 

24 Unchecked_conversion ( 

25 source => System. untyped_word, 

26 target => Data_Definition_Mgt .DDef_AD) ; 
27 

28 — Variables: 
29 

30 menu_group_DDef_AD: Data_Def inition_Mgt .DDef_AD; 

31 — AD to stored menu group DDef . 
32 

33 menu_group_node : 

34 Data_Definition_Mgt .node_reference; 

35 — Node reference to stored menu group DDef. 
36 

37 

38 procedure Set_up_menu_group 

39 

40 is 

41 

42 begin 

43 

44 — Retrieve menu group's DDef: 

45 

4 6 menu_group_DDef_AD := DDef_f rom_untyped ( 

47 Di rectory _Mgt .Retrieve ( 

48 name => menu_group_DDef_path) ) ; 
49 

50 

51 — Retrieve menu group's root node: 

52 

53 menu_group_node := Data_Definition_Mgt. 

54 Retrieve_DDef ( 

55 DDef => menu_group_DDef_AD, 

56 name => menu_group_DDef_root_name) ; 
57 

58 

59 — Install menu group: 

60 

61 Window_Services.Ops.Install_menu_group ( 

62 window => Inventory _Windows. 

63 main_window, 

64 menu_group => menu_group_node, 

65 ID => inv_menu_group_ID) ; 
66 

67 — Enable menu group: 
68 

69 Window_Services.Ops.Menu_group_enable { 

70 window => Inventory_Windows. 

71 main_window, 

72 menu_group => inv_menu_group_ID, 

73 enable => true) ; 
74 
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end Set_up_menu_group; 



procedure Process_inquiry_menu( 

selection: Terminal_Defs.menu_item_ID) 
— Selection made in this menu, 
is 

— Logic: 

— Determine item selection, perform actions. 

begin 

case selection is 

when inq_by_part_item => Inventory _Forms. 
Process_inquiry_form; 

when inq_by_desc_item => 

Message_Services.Write_msg ( 

msg_id => no_selection_code, 
paraml => 

Incident_Defs.message_parameter ( 
typ => Incident_Defs.ord, 
len => 0)' ( 

typ => Incident_Def s.ord, 

len => 0, 

o_val => selection)); 

when inq_exit_item => 
return; 

when others => null; 

end case; 

end Process_inquiry_menu; 



procedure Process_posting_menu ( 

selection: Terminal_Defs.menu_item_ID) 
— Selection made in this menu, 
is 
— Logic: 

Determine item selection, perform actions. 

begin 

case selection is 

when post_receipt_item => Inventory _Forms. 
Process_receipts_form; 

when post_issue_item | 
post_return_item | 
post_spoilage_item | 
post_journal_item => 

Message_Services.wri te_msg ( 

msg_id => no_selection_code, 
paraml => Incident_Defs.message_parameter ( 
typ => Incident_Def s.ord, 
len => 0)' ( 

typ => Incident_Def s.ord, 

len => 0, 

o_val => selection)); 

when post_exit_item => 
return; 

when others => null; 

end case; 

end Process_posting_menu; 
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procedure Process_update_menu ( 

selection: Terminal_Def s.menu_item_ID) 

— Selection made in this menu, 
is 
— Logic: 

Determine item selection, perform actions. 

begin 

case selection is 

when update_add_item I 
update_change_item I 
update_delete_item => 

Inventory _Forms . Process_update_f orm ( 
selection => selection) ; 

when update_exit_item => 
return; 

when others => null; 

end case; 

end Process update menu; 



procedure Process_report_menu ( 

selection: Terminal_Defs.menu_item_ID) 
— Selection made in this menu. 

is 

report_out_dev: System_Def s. text (256) ; 

begin 

case selection is 

when report_by_part_item => 

Inventory _Forms.Process_report_f orm ( 
report_by_part => true, 
report_out_dev => report_out_dev) ; 

Inventory _Reports.Print_report_by_part ( 

output_dev_pathname => report_out_dev) ; 

when report_by_location_item => 

Inventory _Forms.Process_report_f orm { 
report_by_part => false, 
report_out_dev => report_out_dev) ; 

Inventory _Reports.Print_report_by_location < 
output_dev_pathname => report_out_dev) ; 

when report_exit_item => 
return; 

when others => null; 

end case; 

end Process report menu; 



procedure Process_housekeeping_menu ( 

selection: Terminal_Defs.menu_item_ID) 
— Selection made in this menu, 
is 

begin 
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229 case selection is 

230 

231 when hskpg_index_item => 

232 

233 File_Admin.Reorganize_index ( 

234 file => File_Defs.Convert_device_to_file ( 

235 s => Record_AM.Ops.Get_device_object ( 

236 opened_dev => 

237 Inventory_Files.parts_file) ) , 

238 index => 

239 Inventory _Files.part_ID_index_name) ; 
240 

241 when hskpg_exit_item => 

242 return; 
243 

244 when others => null; 

245 

24 6 end case; 

247 

248 end Process_housekeeping_menu; 

249 

250 

251 end Inventory Menus; 
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X-A.5.8 inventory Reports Package Specification 



1 with Device_Defs, 

2 Incident_Defs, t 

3 Inventory _Messages, V 

4 System, 

5 System_Defs, 

6 Terminal_Defs, 

7 Window_Services; 
8 

9 package Inventory_Reports is 
10 

11 — Function: 

12 — Contains two procedures to process and 

13 — print either of the Inventory Program 

14 — reports (by part ID solely, or by part 

15 — location and then part ID) from the 

16 — Inventory Parts file. 
17 

18 — One or the other of these procedures is 

19 == called from the Report Menu by the 

20 — apppropriate menu selection: "Print 

21 — "Report by Part", or "Print Report by" 

22 — "Location". 
23 

24 — History: 

25 — 05-21-87, William A. Rohm: Written. 

26 — 10-27-87, WAR: Revised. 
27 

28 — End of Header 

29 

30 — Incident codes for messages: 

31 

32 module: constant := 6; 

33 — Message module index. 
34 

35 — *M* set. language : language = English 

3 6 — *M* create. variable module : value = 6 

37 

38 report_printing_code: constant V 

3 9 Incident_Defs.incident_code := ( 

40 message_object => 

41 Inventory _Messages.message_object, 

42 module => module, 

43 number => 0, 

44 severity => 

45 Incident_Defs. information) ; 
46 

47 — *M* store :module = $module : number = 0\ 

48 — *M* :msg_name = report_printing \ 

4 9 — *M* : short = "Inventory parts file 

50 — *M* report by $pl<part/location> 

51 — *M* is now printing on device 

52 — *M* $p2<output device name>." 
53 

54 

55 report_by_part_DDef_str: constant string := 

56 " /example/invent ory/DDef s/report_by_part "; 

57 — String constant for "report by part" 

58 — report DDef ' s pathname. 
59 

60 report_by_part_DDef_pathname: 

61 System_Defs»text ( 

62 report_by_part_DDef_str' length) := ( 

63 report_by_part_DDef_str' length, 

64 report_by_part_DDef_str' length, 

65 report_by_part_DDef_str) ; 

66 — Text constant from "report by part" 

67 — DDef s pathname string. 
68 

69 

70 report_by_loc_DDef_str: constant string := 

71 "/example/ inventory /DDef s/report_by_locat ion"; 

72 — String constant for "report by location" 

73 — report DDef's pathname. ( 
74 
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75 report_by_loc_DDef_pathname: 

7 6 System_Def s . text ( 

77 report_by_loc_DDef_str' length) := ( 

78 report_by_loc_DDef_str' length, 

79 report_by_loc_DDef_str' length, 

80 report_by_loc_DDef_str) ; 

81 — Text constant from "report by location" 

82 — DDef ' s pathname string. 
83 

84 

85 sort_by_loc_DDef_str: constant string := 

86 "/example/ inventory /DDef s/sort_by_locat ion"; 

87 — String constant for "sort by location" 

88 — "(then by part ID)" sort DDef ' s pathname. 
89 

90 sort_by_loc_DDef_pathname: 

91 System_Defs.text ( 

92 sort_by_loc_DDef_str' length) := ( 

93 sort_by_loc_DDef_str' length, 

94 sort_by_loc_DDef_str' length, 

95 sort_by_loc_DDef_str) ; 

96 — Text constant from "sort by location" 

97 — DDef ' s pathname string. 
98 

99 

100 procedure Print_report_by_part ( 

101 output_dev_pathname : System_Def s .text) ; 

102 — Pathname of output device for 

103 — printing report. Can be any device 

104 — supporting the byte stream access 

105 — method. 
106 

107 — Function: 

108 — Prepares report *by part ID* from parts 

109 — file, then prints report to given 
output device. 



110 — output device. 

Ill 



112 

113 procedure Print_report_by_location ( 

114 output_dev_pathname : System_Def s . text) ; 

115 — Pathname of output device for 

116 — printing report. Can be any device 

117 — supporting the byte stream access 

118 — method. 
119 

120 — Function: 

121 — Sorts parts file by location (and then 

122 — by part ID) into temporary file, then 

123 — prints report to given output device. 
124 

125 end Inventory_Reports; 
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X-A.5.9 inventory_Reports Package Body 

Note: This example could not be compiled successfully due to the absence of the the 
Report_Handler package at the time of this printing. 

1 with Byte_Stream_AM, 

2 Data_Definition_Mgt, 

3 Device_Defs, 

4 Directory_Mgt, 

5 Event_Mgt , 

6 File_Admin, 

7 File_Defs, 

8 Incident_Defs, 

9 Inventory_Files, 

10 Inventory_Windows, 

11 Message_Services, 

12 Passive_Store_Mgt, 

13 Pipe_Mgt, 

14 Process_Mgt, 

15 Proeess_Mgt_Types, 

16 Record_AM, 

17 Report_Handler, 

18 Sort_Merge_Interface, 

19 System, 

20 System_Defs, 

21 Terminal_Defs, 

22 Unchecked_conversion, 

23 Volume_Set_Defs; 
24 

25 package body Inventory_Reports is 
26 

27 — History: 

28 — 05-21-87, William A. Rohm: Written. 

29 — 10-27-87, WAR: Revised. 
30 

31 — End of Header 

32 

33 — Generic function: 

34 

35 function DDef_from_untyped is new 

36 Unchecked_conversion { 

37 source => System. untyped_word, 

38 target => Data_Definition_Mgt .DDef_AD) ; 
39 

40 — Type: 
41 

42 type connection_record is 

43 — Defines sort pipe's input and output, for 

44 — "Sort" and "Print" processes (called by 

45 — "Print_report_by_location") . 

46 record 

47 sort_out: Device_Defs. opened_device; 

48 — Output from "Sort" to pipe. 

49 report_in: Device_Defs.opened_device; 

50 — Input from pipe to "Print". 

51 report_out: Device_Defs.opened_device; 

52 — Output device for "Print". 

53 end record; 
54 

55 

56 procedure Print_report_by_part ( 

57 output_dev_pathname : System_Defs.text) 
58 

59 — Logic: 

60 — 1. Open parts file for reading 

61 — 2. Open report output device 

62 — 3. Get report DDef and initialize report 

63 — 4. Print report and display message 
64 

65 is 
66 

67 opened_output : Device_Defs.opened_device; 

68 — Opened output device for printing report. 
69 

70 report_DDef: Data_Definition_Mgt.DDef_AD; 

71 — AD to a report data definition. 
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initialized_report : Device_Def s . opened_device; 

— Initialized (opened) report object itself. 

local_parts_file: Device_Defs. device := 
Record_AM.Ops.Get_device_object ( 
Inventory _Files.parts_file) ; 
— AD to parts file. 

opened_local_parts_file: 

Device_Defs.opened_device; 

— AD to locally opened parts file. 

part: System_Defs.text (4) := (4, 4, "part") ; 

— Parameter to "report_printing" message, 

— since this report is by "part". 

begin 

— Open parts file for reading, so no 

— concurrent updates will interfere: 

opened_local_parts_file := Record_AM. Ops. Open ( 
dev => local_parts_file, 

input_output => Device_Defs. input, 
allow => Device Defs. readers) ; 



— Open output device: 

opened_output := Byte_Stream_AM.Open_by_name ( 
name => 

output_dev_pathname , 
input_output => 

Devi ce_Defs. output) ; 



— Get report definition (DDef ) : 

report_DDef := DDef_from_untyped ( 
Di rectory _Mgt .Retrieve { 

name => report_by_part_DDef_pathname) ) ; 

— Assume "Report_Handler.Is_report". 



— Initialize report: 

initialized_report := Report_Handler. Initialize ( 
description => report_DDef, 
input => opened_local_parts_file, 
output => opened output) ; 



— Print report: 

Report_Handler. Print ( 

report => initialized report) ; 



— Display "report_printing" message: 

Message_Services.Write_msg( 

msg_id => report_printing_code, 
paraml => Incident_Defs.message_parameter ( 
typ => Incident_Defs.txt, 
len => part .length) ' ( 

typ => Incident_Defs.txt, 
len => part. length, 
txt_val => part), 
param2 => Incident_Defs.message_parameter ( 
typ => Incident_Defs.txt, 
len => output_dev_pathname. length) ' ( 
typ => Incident_Defs.txt, 
len => output_dev_pathname. length, 
txt_val => output_dev_pathname) , 
device => Inventory_Windows.message_window) ; 
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— Close locally opened parts file: 

Record_AM. Ops. Close ( 

opened_dev -> opened_local_parts_file) ; 

end Print_report_by_part; 



procedure Sort ( 

param_buffer: System. address; 

— Address of connection record. 
param_length: System. ordinal) 

— Not used in this procedure, but required for 

— process's initial procedure. 

— Logic: 

1. Open local copy of parts file (sort input) 

2. Get sort DDef and perform sort 
is 

conn_rec: connection_record; 

— Record containing pipe input/output devices. 
FOR conn_rec USE AT param_buf fer; 

local_parts_file: Device_Defs. device := 
Record_AM.Ops.Get_device_object ( 
Inventory _Files. parts_file) ; 
— AD to parts file. 

opened_local_part s_f ile : Device_Def s . opened_device; 

— AD to locally opened parts file. 

opened_sort_DDef : 

Device_Defs.opened_device; 
sort_DDef_ref erence : 

Data_Definition_Mgt .node_reference; 

begin 

— Open parts file for reading, so no 

— concurrent updates will interfere: 

opened_local_parts_file := Record_AM. Ops. Open ( 
dev => local_parts_file, 

input_output => Device_Defs. input, 
allow => Device Defs. readers) ; 



— Open sort definition (DDef) : 

opened_sort_DDef := Record_AM.Open_by_name ( 
name => 

sort_by_loc_DDef_pathname, 
input_output => Device_Defs. input, 
allow => Device_Defs. readers, 
block => true) ; 

— Get sort DDef's node reference: 

sort_DDef_ref erence := 

Record_AM . Ops . Get_DDef ( 

opened dev => opened sort DDef) ; 



— Perform sort, using sort DDef, from parts 

— file to pipe: 

Sort_Merge_Interf ace . Sort ( 
input_device => 

opened_local_parts_file, 
DDef => sort_DDef_reference, 

output_device => conn_rec.sort_out, 
stable_sort => true, 
tuning_opts => 

Sort_Merge_Inter f ace . no_tuning) ; 
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— Close locally opened parts file: 

Record_AM. Ops. Close ( 

opened_dev => opened_local_parts_file) ; 

end Sort; 

pragma subprogram_value ( 

Process_Mgt . Initial_proc, 
Sort); 



procedure Print ( 

param_buffer: System. address; 

— Address of connection record. 
param_length: System. ordinal) 

— Not used in this procedure, but required for 

— process's initial procedure. 

— Logic: 

1. Get report DDef 

2. Open report output 

3. Get report DDef and initialize report 

4. Print report from pipe output. 



report_DDef : Data_Definition_Mgt .DDef_AD; 

— AD to a report data definition. 

initialized_report : Device_Defs.opened_device; 

— Initialized (opened) report object itself. 

conn_rec: connection_record; 

— Record containing pipe input/output devices. 
FOR conn_rec USE AT param_buf fer; 

begin 

— Get report definition (DDef) : 

report_DDef := DDef_from_untyped ( 
Directory_Mgt. Retrieve ( 

report_by_loc_DDef_pathname) ) ; 

— Initialize report: 

initialized_report := Report_Handler. Initialize ( 
description => report_DDef, 
input => conn_rec.report_in, 
output => conn_rec.report_out) ; 

— Print report: 

Report_Handler. Print ( 

report => initialized_report) ; 

— Close report output device: 

Record_AM. Ops. Close ( 

opened_dev => conn_rec. report_out) ; 

end Print; 

pragma subprogram_value (Process_Mgt . Initial_proc, 

Print) ; 



procedure Print_report_by_location ( 

output_dev_pathname : Sy stem_Def s . text ) 

— Logic: 

1. Open pipe input (sort output) and 
output (report input) 

2. Spawn "Sort" and "Print" processes 

3. Wait for termination of processes 

4. Deallocate processes 

5. Display "report printing" message 
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conn_rec: connection_record; 

— Record referencing all I/O connections used by 

— the child processes. 

sort_pipe: Pipe_Mgt .pipe_AD; 

— Pipe from sort output to report input. 

this_process_untyped: System. untyped_word; 

— Process executing call to 

— * , Print_report_by_location ,, / as an 

— untyped word. 

sort_process: Process_Mgt_Types.process_AD; 

— Process executing "Sort". 

print_process: Process_Mgt_Types.process_AD; 

— Process executing "Print". 

term_events: Event_Mgt .action_record_list (2) ; 

— Array that receives termination events of the 

— two child processes. 

location: System_Defs.text (8) := (8, 8, "location") ; 

— Parameter to "report_printing" message, since 

— this report is by "location". 

begin 

— Create pipe: 

sort_pipe := Pipe_Mgt.Create_pipe; 

— Open sort output, report input, and report 

— output devices: 

conn_rec := ( 

sort_out => Record_AM. Ops. Open ( 
Pipe_Mgt .Convert_pipe_to_device ( 

sort_pipe) , 
Device_Defs. output) , 
report_in => Record_AM. Ops. Open ( 
Pipe_Mgt.Convert_pipe_to_device { 

sort_pipe) , 
Device_Defs. input) , 
report_out => Record_AM.Open_by_name ( 
output_dev_pathname , 
Device_Defs. output) ) ; 

— Get this process's AD: 

this_process_untyped := 

Process_Mgt .Get_process_globals_entry ( 
Process_Mgt_Types. process) ; 

— Spawn "Sort" process: 

sort_process := Process_Mgt.Spawn_process ( 
init_proc => Sort' subprogram_value, 
param_buffer => conn_rec' address, 
term_action => ( 

event => Event_Mgt .user_l, 
message => System. null_address, 
destination => this_process_untyped) ) ; 

— Spawn "Print" process: 

print_process := Process_Mgt.Spawn_process ( 
init_proc => Print' subprogram_value, 
param_buffer => conn_rec' address, 
term_action => ( 

event => Event_Mgt .user_2, 
message => System. null_address, 
destination => this_process_untyped) ) ; 

— Wait for both processes to finish: 
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380 Event_Mgt.Wait_for_all( 

381 events => 

382 (Event_Mgt.user_l .. Event_Mgt.user_2 => 

383 true, 

384 others => false) , 

385 action_list => term_events) ; 
386 

387 — The two processes must have terminated, so they 

388 — can be deallocated: 
389 

390 Process_Mgt .Deallocate (sort_process) ; 

391 Process_Mgt .Deallocate (print_process) ; 
392 

393 — Display "report printing" message: 
394 

395 Message_Services.Write_msg( 

396 msg_id => report_printing_code, 

397 paraml => Incident_Defs.message_parameter ( 

398 — "location" 

399 typ => Incident_Defs.txt, 

400 len => location. length) ' ( 

401 typ => Incident_Defs.txt, 

402 len => location. length, 

403 txt_val => location) , 

404 param2 => Incident_Defs.message_parameter ( 

405 — "output device pathname" 

406 typ => Incident_Defs.txt, 

407 len => output_dev_pathname. length) ' ( 

408 typ => Incident_Defs.txt, 

409 len => output_dev_pathname. length, 

410 txt_val => output_dev_pathname) ) ; 
411 

412 end Print_report_by_location; 

413 

414 end Inventory_Reports; 

415 
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X-A.5.10 inventory_windows Package Specification 



1 with Device_Defs, 

2 Terminal_Defs; 
3 

4 package Invent ory_Windows is 
5 

6 — Function: 

7 — Contains procedures to open and close the two 

8 — Inventory Program windows: the main window and 

9 — the message window. 
10 

11 — The main window is used for menu and form 

12 — display and for user data entry. The message 

13 — window is only used to display status and error 

14 — messages to the user. 
15 

16 — History: 

17 — 06-04-87, William A. Rohm: Written. 
18 

19 — End of Header 

20 

21 — Constants: 

22 

23 module: constant := 2; 

24 — Message module index value, for this 

25 — package's messages. Not currently used. 
26 

27 main_window_size: Terminal_Defs.point_info := ( 

28 80,20); 

29 — Size of main window, in columns and rows. 
30 

31 main_buf fer_size: Terminal_Defs.point_info := ( 

32 80,20); 

33 — Size of main window's buffer. 
34 

35 main_window_pos: Terminal_Def s.point_info := ( 

36 1,1); 

37 — Position of main window (upper left corner) . 
38 

39 message_window_size: Terminal_Defs.point_info := ( 

40 80,3); 

41 — Size of message window, in columns and rows. 
42 

43 message_buffer_size: Terminal_Defs.point_info := ( 

44 80,3); 

45 — Size of message window's buffer. 
46 

47 message_window_pos: Terminal_Defs.point_info := ( 

48 1, 1 + main_window_pos.vert) ; 

49 — Position of message window (just below main 

50 — window) . 
51 

52 — Variables: 
53 

54 main_window: Device_Defs.opened_device; 

55 — Main window, for displaying menus and forms 

56 — and getting user input. Usable by other 

57 — modules after "Open_program_windows" has been 

58 — called. 
59 

60 message_window: Devi ce_Defs.opened_de vice; 

61 — Message window, for status and error 

62 — messages. Usable by other modules after 
63. — "Open_program_windows" has been called. 
64 

65 

66 

67 procedure Open_program_windows; 

68 

69 — Function: 

70 — Open both program windows (main and message) 

71 — on the current terminal. 
72 

73 — The main window is for the Inventory 

74 — Program's menus and forms. The message 



X- A- 1 52 Ada Examples 



PRELIMINARY 



75 — window is opened, for message display. 
76 

77 — The main window is opened at the top of the 

78 — screen. The message window is opened below 

79 — the main window. 
80 

81 

82 

83 procedure Close_program_windows; 

84 

85 — Function: 

86 — Closes both Inventory Program windows: mair 

87 — window and message window. 
88 

89 

90 end Inventory_Windows; 

91 
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X-A.5.1 1 inventory_windows Package Body 



1 with Byte_Stream_AM, 

2 Device_Defs, 

3 Process_Mgt, 

4 Process_Mgt_Types, 

5 System, 

6 Terminal_Defs, 

7 Window_Services; 
8 

9 package body Inventory_Windows 

10 is 
11 

12 procedure Open_program_windows 
13 

14 — Logic: 

15 — 1. Gets device AD to underlying terminal. 

16 — 2. Opens main window, assigning 

17 — "inventory _main" . 

18 — 3. Opens message window, assigning 

19 — "inventory_message" . 
20 

21 is 

22 old_opened_window: Device_Defs.opened_device; 

23 old_window: Device_Defs. device; 

24 underlying_terminal: Device_Defs. device; 
25 

26 begin 
27 

28 — Assume standard input, on entry, is from an 

29 — opened window: 
30 

31 old_opened_window := 

32 Process_Mgt .Get_process_globals_entry ( 

33 Process_Mgt_Types.standard_input) ; 
34 

35 — Get device object of standard input window: 
36 

37 old_window := Byte_Stream_AM.Ops.Get_device_object ( 

38 old_opened_window) ; 
39 

40 — Get device AD of standard input window's 

41 — terminal: 
42 

43 underlying_terminal := 

44 Window_Services . Ops . Get_terminal ( 

45 old_window) ; 
46 

47 — Create new main window: 
48 

49 main_window := Window_Services.Ops.Create__window ( 

50 terminal => underlying_terminal, 

51 pixel_units => false, 

52 — characters, not pixels 

53 fb_size => main_buf fer_size, 

54 desired_window_size => main_window_size, 

55 window_pos => main_window_pos, 

56 view_pos => 

57 Terminal_Defs.point_info' (1,1)); 
58 

59 

60 — Create new message window: 

61 

62 message_window := Window_Services.Ops.Create_window ( 

63 terminal => underlying_terminal, 

64 pixel_units => false, 

65 fb_size => message_buf fer_size, 

66 desired_window_size => message_window_size, 

67 window_pos => message_window_pos, 

68 view_pos => 

69 Terminal_Defs.point_info' (1,1)); 
70 

71 end Open_program_windows; 

72 

73 

74 
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75 procedure Close_program_windows 
76 

77 — Logic: 

78 — 1. Closes main window. 

79 — 2. Closes message window. 
80 

81 is 

82 

83 begin 

84 

85 Window_Services.Ops.Destroy_window (main_window) ; 

86 

87 Window_Services. Ops. Destroy _window (message_window) ; 

88 

89 end Close_program_windows; 

90 

91 end Inventory Windows; 
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X-A.5.12 Inventory Messages Package Specification 



1 with Incident_Defs, 

2 System, 

3 System_Defs; 
4 

5 package Inventory_Messages is 
6 

7 — Function: 

8 — Defines Inventory Example Program's message 

9 — object, used for all incident code declarations 
10 — in the program. 

11 

12 — Each package defines its own messages (using 

13 — tagged message definitions) with its unique 

14 — module number. 
15 

16 — History: 

17 -- 07-27-87, William A. Rohm: Written. 

18 — 10-27-87, WAR: Revised. 
19 

20 — End of Header 

21 

22 — Constants: 

23 

24 message_file: constant System_Defs.text_AD := 

25 new System_Def s. text' ( 

26 31, 31, "/example/inventory/message_file") ; 

27 — AD to message file text name. 
28 

29 — *This will go away when "pragma bind" changes.* 

30 

31 

32 message_object : constant System. untyped_word := 

33 System. null_word; 
34 

35 pragma bind (message_object, 

36 " invent ory_mes sages. me ssage_file") ; 

37 — Message object for Inventory Program incident 

38 — codes. Bound to "message_file" constant by 

39 — pragma "bind". 
40 

41 — *When the resident compiler/linker is in place,* 

42 — *this pragma will become:* 

43 — | pragma bind(message_object, 

44 — | "/example/inventory/message_file") 
45 

46 end Inventory Messages; 
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X-A.6.1 At_cmd_ex Procedure 

1 with At_Support_Ex, 

2 Command_Handler, 

3 Device_Defs, 

4 Long_Integer_Defs, 

5 Message_Services, 

6 System_Defs, 

7 Timed Requests Mgt; 



9 procedure At_cmd_ex 
10 

11 — Function: 

12 — This procedure will run a command at a specified time. 

13 — It sets defaults for unspecified parameters and 

14 — parses mandatory and specified time parameters 

15 — and calls subprogram that will initial a new session 

16 — and job to run the command. The prompt will 

17 — return after the new job is started. The until 

18 — and count arguments are only effective if period is 

19 — set 
20 

21 — History: 

22 — 04-05-88, Ed Sassone, creation date 

23 — 05-20-88, Ed Sassone, working version 
24 

25 — End of Header 

26 

27 

28 — Command Definition: 

29 — at_cmd_ex : time=<extended_string_list (1 . . 25 (1 . .11) ) > 

30 — :command=<extended_string(l. . 80) > 

31 ~ [:period=<extended_string_list(0. .25 (0. .11) )>:=(" () ") ] 

32 — [:until=<extended_string_list (0. .25 (0. .11) )>:=(" () ") ] 

33 — [:count=<integer(l. .1_000) >:=1_000] 
34 

35 

3 6 — *D* manage . commands 

37 — *D* create. invocation_commarid 

38 — *D* 

3 9 — *D* define. argument time \ 

40 — *D* :type = string_list 

41 — *D* set .maximum_length 25 11 

42 — *D* set. mandatory 

43 — *D* end 

44 — * D * 

45 — *D* define. argument command \ 

4 6 — *D* :type = string 

47 — *D* set .maximum_length 80 

48 — *D* set .mandatory 

49 — *D* end 

50 — *d* 

51 — *D* define. argument period \ 

52 — *D* :type = string_list 

53 — *D* set .maximum_length 25 11 

54 — *D* allow. null_values :list :element 

55 — *D* . set.value_default "()" 

56 — *D* end 

57 — *D* 

58 — *D* define. argument until \ 

59 — * D * :type = string_list 

60 — *D* set .maximum_length 25 11 

61 — *D* allow. null_values :list : element 

62 — *D* set.value_default "()" 

63 — *D* end 

64 — *D* 

65 — *D* define. argument count \ 

66 — *D* :type=integer 

67 — * D * set.value_default 1000 — function ($$upper) NYI 

68 — *d* set. bounds 1..1000 — open bounds NYI 

69 — *d* end 

70 — *D* 

71 — *D* end — create. invocation_command 
72 

73 is 
74 
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75 

76 use Long_Integer_Defs; — for time comparison 

77 

78 

79 odo: Device_Defs.opened_device; 

80 

81 — parameters 

82 time: System_Defs. string_list (25) := 

83 (25, 0, 0, (others => ' ')); 
84 

85 command: System_Defs.text (80) := 

86 (80, 0, (others => ' ')); 
87 

88 period: System_Defs.string_list (25) := 

89 (25, 0, 0, (others => ' ')); 
90 

91 until: System_Defs.string_list (25) := 

92 (25, 0, 0, (others => ' ')); 
93 

94 count: integer; 

95 

96 

97 start_at: System_Defs. system_time_units := 

98 System_Defs.null_time; 

99 — stu equivalent of time 
100 

101 next_at: System_Defs.system_time_units := 

102 System_Defs.null_time; 

103 — stu equivalent of period 
104 

105 until_at: System_Defs.system_time_units := 

106 Long_Integer_Defs.max_int; 

107 — stu equivalent of until 
108 

109 begin 
110 

111 odo := Command_Handler. 

112 Open_invocation_command_processing; 
113 

114 Command_Handler.Get_string_list ( 

115 cmd_odo => odo, 

116 arg_number => 1, 

117 arg_value => time) ; 
118 

119 Command_Handler.Get_string( 

120 cmd_odo => odo, 

121 arg_number => 2, 

122 arg_value => command) ; 
123 

124 Command_Handler.Get_string_list ( 

125 cmd_odo => odo, 

126 arg_number => 3, 

127 arg_value => period) ; 
128 

129 Command_Handler.Get_string_list ( 

130 cmd_odo => odo, 

131 arg_number => 4, 

132 arg_value => until); 
133 

134 count := 

135 Command_Handler.Get_integer ( 

136 cmd_odo => odo, 

137 arg_number => 5); 
138 

139 Command_Handler. Close (odo) ; 

140 

141 — parse timing arguments 

142 

143 start_at := 

144 At_Support_Ex.Parse_time ( 

145 time => time, 

146 from_when => Timed_Requests_Mgt . system_epoch) 
147 

148 if period. length > 4 then 

149 — keep defaults if nothing assigned 

150 next_at := 

151 At Support Ex. Parse time( 
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152 time => period, 

153 from_when => Timed_Requests_Mgt.now) ; 

154 else 

155 count := 1; — if no period do command only once 

156 end if; 
157 

158 if until. length > 4 then 

159 — keep defaults if nothing assigned 

160 until_at := 

161 At_Support_Ex.Parse_time ( 

162 time => until, 

163 from_when => Timed_Requests_Mgt.system_epoch) 

164 end if; 
165 

166 if start_at < Timed_Requests_Mgt.get_time then 
167 

168 Message_Services.Write_msg( 

169 msg_id => At_Support_Ex.prior_time_warning_code) ; 

170 end if; 
171 

172 — creates new session and job so prompt will return 

173 At_Support_Ex.Create_waiting_process ( 

174 invocation_record => At_Support_Ex.program_record' ( 

175 command => command, 

176 stu_start => start_at, 

177 stu_period => next_at, 

178 stu_until => until_at, 

179 count => count)); 
180 

181 end At cmd ex; 
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X-A.6.2 At_Support_Ex Package Specification 



1 with Incident_Defs, 

2 Process_Mgt, 

3 Timed_Request s_Mgt , 

4 System, 

5 System_Defs; 
6 

7 package At_Support_Ex is 

8 

9 — Function: 

10 — Provides support for At_cmd_ex. Parses time 

11 — arguments and invokes the given command either 

12 — once at the specified time or from the given time 

13 — multiple times based on a specified period until 

14 — a given count or time limit, whichever is first. 
15 

16 — History: 

17 — 04-05-88, Ed Sassone, creation date 

18 — 05-20-88, Ed Sassone, working version 
19 

20 — Exception Codes: 

21 msg_obj: constant System. untyped_word := 

22 System. null_word; — use oeo 
23 

24 time_format_error_code: constant Incident_Defs. 

25 incident_code := ( 

26 module => 0, 

27 number => 1, 

28 severity => Incident_Defs. error, 

29 message_object => msg_obj); 

30 day_format_error_code: constant Incident_Defs. 

31 incident_code := ( 

32 module => 0, 

33 number => 2, 

34 severity => Incident_Defs. error, 

35 message_ob ject => msg_obj); 
36 

37 prior_time_warning_code: constant Incident_Defs. 

38 incident_code := ( 

39 module => 0, 

40 number => 3, 

41 severity => Incident_Defs. warning, 

42 message_object => msg_obj); 
43 

44 

45 — Exceptions: 

46 

47 — *D* manage. mess ages 

48 

49 time_format_error: exception; 

50 — Occurs when the time was not input in a proper 

51 — format 

52 — *D* store 1 time_format_error \ 

53 — *D* : short = "$pl is an improper time specification 

54 — *D*The correct format is hh[ :mm[:ss[ .dd] ] ] " 

55 day_format_error: exception; 

56 — Occurs when the day was not input in a proper 

57 — format 

58 — *D* store 2 day_format_error \ 

59 — *D* : short = "$pl is an improper time specification 

60 — *D*The correct format is [MM/]DD[/YYYY] ] " 
61 

62 

63 — Warning message occurs when the time 

64 — specified has already past 

65 — *D* store 3 prior_time_warning \ 

66 — *D* : short = "The specified time has already past. 

67 — *D*Command is executed immediately." 
68 

69 — End of Header 

70 

71 

72 type program_record is record 

73 — times in this record are all in 

74 — system_time_units to be used by Timed_request 
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75 command: System_Defs.text (80) ; 

76 — command to be run with arguments 

77 stu_start: System_Defs.system_time_units; 

78 — initial request 

79 stu_period: System_Defs.system_time_units; 

80 — interval between execution (optional argument) 

81 stu_until: System_Def s.system_time_units; 

82 — upper time limit on command run more than once 

83 count: integer; 

84 — number of times job will run 

85 end record; 
86 

87 
88 

89 function Parse_time( 

90 time: System_Defs.string_list; 

91 — time from command line 

92 from_when: Timed_Requests_Mgt. from_when_type) 

93 — specifies time to be relative to now 

94 — or absolute 

95 return System_Def s. system_time_units; 

96 — time in form usable for 

97 — Timed_Request.Enter_request 
98 

99 — Function: 

100 — Parses the time argument on the command line and 

101 — converts to system_time_units. The time 

102 — specification is divided into two strings, the 

103 — first being mandatory specifying hours and 

104 — minutes and optionally seconds and hundredths of 

105 — seconds. The second string is optional and 

106 — specifies the day of month and optionally the 

107 — month and year. 
108 

109 — Exceptions: 

110 — time_format_error - raised when the hour string list 

111 — input for the timing 

112 — parameters is incorrect. 
113 

114 — day_format_error - raised when the day string list 

115 — input for the timing parameters 

116 — is incorrect. 
117 

118 

119 procedure Create_waiting_process ( 

120 invocation_record: program_record) ; 
121 

122 — Function: 

123 — Creates a new session, job and process to wait 

124 — for specified time to execute. 
125 

126 
127 
128 

129 procedure Wait_program( 

130 param_buffer: System. address; 

131 param_length: System. ordinal) ; 

132 pragma subprogram_value (Process_Mgt .initial_proc, 

133 Wait_program) ; 
134 

135 — Function: 

136 — Created in a new session and job. Process issues 

137 — a timed request and waits on the locked semaphore 

138 — for specified time to execute program passed in 

139 — as a parameter. If the command is specified more 

140 — than once it will loop, issue another timing 

141 — request and reset the semaphore and wait. 
142 

143 

144 end At Support Ex; 
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X-A.6.3 At_Support_Ex Package Body 



1 with Command_Execution, 

2 Directory_Mgt, 

3 Job_Admin, — trusted 

4 Job_Mgt, 

5 JobJTypes, 

6 Long_Integer_Defs, 

7 Incident_Defs, 

8 Message_Services, 

9 Message_Stack_Mgt, 

1 Semapho re_Mgt , 

11 Session_Mgt, 

12 Session_Types, 

13 String_List_Mgt, 

14 System, 

15 System_Defs, 

16 Text_IO, 

17 Text_Mgt, 

18 Timed = Requests_Mgt, 

19 Timing_String_Conversions, 

20 Timing_Conversions; 
21 

22 package body At_Support_Ex is 
23 

24 — Logic: 

25 — Supports at command by parsing time specification and creating 

26 — new session, job and process that will wait for timing requests 

27 — to invoke the waiting process. 
28 

29 — History: 

30 — 04-05-88, Ed Sassone, creation date 

31 — 05-20-88, Ed Sassone, working version 
32 

33 — End of Header 
34 

35 

36 ~ PARSE_TIME 

37 

38 function Parse_time ( 

39 time: System_Defs. string_list; 

40 from_when: Timed_Requests_Mgt. from_when_type) 

41 return System_Defs.system_time_units 
42 

43 — Logic: 

44 — This function first parses the mandatory string 

45 — containing hours, minutes, seconds, hundreths and 

46 — then it parses the second optional string 

47 — containing month day and year. For each string 

48 — it counts the number and position of the 

49 — separator. For the first string that is the ':' 

50 — • and the '.' if hundreths are specified. 

51 — For the second string it is the '/'. Based on the 

52 — separator positions, substrings representing the 

53 — individual time elements are copied into the 

54 — appropriate fields of string_time. 
55 

56 is 

57 

58 

59 use Timed_Requests_Mgt; 

60 — needed in "if from_when = system_epoch statement" 
61 

62 

63 dum_text: constant System_Defs. text (11) := 

64 (11, 11, (others => ' ')); 

65 — used for the following initialization only: 
66 

67 string_time: Timing_String_Conversions. string_time .: = 

68 ("0000", " ", "00", "00", "00", "00", "00", dum_text, 

69 " ", " "); 

70 — specified time values are copied into fields if 

71 — absolute time is used value is preloaded with 

72 — current time. Fields specified are overwritten 
73 

74 string_interval: Timing_String_Conversions.string_interval; 
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— used for period (relative time) 

hour_time: System_Defs.text (Incident_Defs.txt_length) 

— used for hh:mm:ss.dd field 

day_time: System_Defs.text (Incident_Defs.txt_length) 

— used for MM/DD/YYYY field 

separators: array (1 .. 2) of 
Sy stem_Def s . text_length; 

— array of positions of separators 

number_separators: integer := 0; 

— hold the number of separators in the field 

month: string (1 .. 2) := "00"; 

— used in place of string_time. month because 

— string_time. month is Jan.. Dec and specified 

— month is 1. .12 

package Int_IO is new Text_IO.Integer_IO (integer) ; 

— needed for conversions from string to numeric 

— month 

begin 

— initialize string_time record 

if from_when = system_epoch then 

— absolute time for current day 
string_time := Timing_String_Conversions. 

Convert_numeric_time_to_string ( 

num_time => Timing_Conversions. 
Convert_stu_to_numeric_time ( 

stu => Timed_Requests_Mgt. 

Get_time) ) ; — current time 

— default if not specified 
st ring_time. minute := "00"; 
string_time. second := "00"; 
string_time. hundredth := "00"; 

end if; 

— *** PARSE MANDATORY HOUR STRING *** 

String_List_Mgt.Get_element { 
from => time, 
el_pos => 1, 
element => hour_time) ; 

— find positions and number of ":" 
number_separators := 0; 
separators := (others => 0); 

for pos in 1 . . hour__time. length 
loop 
if hour_time. value (pos) = ':' then 

number_separators := number_separators + 1; 
— no more than 2 ":" allowed 
if number_separators > 2 then 

RAISE time_format_error; 
end if; 
separators (number_separators) := pos; 

— if non-digit or not the other separator 
elsif (hour_time. value (pos) < '0' or 

hour_time. value (pos) > '9') and 
hour_time. value (pos) /= ' . ' then 
RAISE time_format_error; 
end if; 
end loop; 

case number_separators is 
when => 

if hour_time. length > 2 then 

RAISE time_format_error; 
end if; 

string_time.hour := hour_time. value; 
when 1 => 
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152 if separators (1) /= 3 then 

153 RAISE time_format_error; 

154 end if; 

155 string_time.hour :== hour_t ime. value (1 .. 2); 

156 st ring_t ime. minute := hour_time. value (4 .. 5); 

157 when 2 => 

158 if separators (1) /= 3 or separators (2) /= 6 then 

159 RAISE time_format_error; 

160 end if; 

161 string_t ime. hour := hour_t ime. value (1 .. 2); 

162 string_time. minute := hour_time. value (4 .. 5); 

163 string_time. second := hour_t ime. value (7 .. 8); 
164 

165 — do hundredths if specified 

166 declare 

167 pos: integer := Text_Mgt. Locate ('.' , hour_time) ; 

168 begin 

169 case pos is 

170 when => 

171 null; 

172 when 9 => 

173 string_t ime. hundredth := hour_t ime. value 

174 (pos + 1 . . pos + 2) ; 

175 when others => 

176 RAISE time_format_error; 

177 end case; 

178 end; — declare 

179 when others => 

180 RAISE time_format_error; 

181 end case; 
182 

183 — *** PARSE OPTIONAL DAY STRING *** 
184 

185 if time. count = 2 then 

186 String_List_Mgt.Get_element ( 

187 from => time, 

188 el_pos => 2, 

189 element => day _t ime) ; 
190 

191 — find positions of "/" 

192 number_separators := 0; 

193 separators := (others => 0) ; 

194 for pos in 1 . . day_time. length 

195 loop 

196 if day _t ime. value (pos) = '/' then 

197 number_separators := number_separators +1; 

198 — no more than 2 "/" allowed 

199 if number_separators > 2 then 

200 RAISE day_format_error; 

201 end if; 

202 separators (number_separators) := pos; 

203 — digits only if not a valid separator 

204 elsif day _t ime. value (pos) < '0' or 

205 day__time. value (pos) > '9' then 

206 RAISE day_format_error; 

207 end if; 

208 end loop; 
209 

210 case number_separators is 

211 when => 

212 — day of month only 

213 string_time.day := day _t ime. value; 
214 

215 when 1 => 

216 — month and day 

217 if separators (1) /= 3 then 

218 RAISE day_format_error; 

219 end if; 

220 month := day _t ime. value (1 .. 2); 

221 string_time.day := day_t ime. value (4 .. 5); 
222 

223 when 2 => 

224 — month, day and year 

225 if separators (1) /= 3 or separators (2) /= 6 then 

226 RAISE day_format_error; 

227 end if; 

228 month := day time. value (1 .. 2); 
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string_time.day := day _time. value (4 .. 5); 
string_time.year := day_time. value (7 .. 10) 

when others => 

RAISE day_format_error; 
end case; 



— convert 1..12 month to Jan.. Dec month 
declare 

month_tmp: integer; 

— temporary variable for month conversion 

length: positive; 

— dummy variable for month conversion 



begin 



Int_IO.get ( 

from => month, 
item => month_tmp, 
last => length) ; 



— convert string to ordinal 



case month_tmp is 
when => 

null; — blank initial string 
when 1 => 

string_time. month 
when 2 => 

string_time. month 
when 3 => 

st ring_time. month 
when 4 => 

string_time. month 
when 5 => 

string_time. month 
when 6 => 

string_time. month 
when 7 => 

string_time. month 
when 8 => 

st ring_time . month 
when 9 => 

string_time. month 
when 10 => 

string_time. month 
when 11 => 

string_time . month 
when 12 => 

string_time . month 
when others => 

RAISE day_format_error; 
end case; 
end; — declare 

end if; — if time. count = 2 

— range checking goes here 

if from_when = system_epoch then 

— absolute time 

return Timing_Conversions.Convert_numeric_time_to_stu ( 
num_time => Timing_String_Conversions. 
Convert_string_time_to_numeric ( 
str_time => string_time) ) ; 
else 

— relative time 

— initialize to zero 

string_interval := Timing_String_Conversions. 
Convert_numeric_interval_to_string( 

num_interval => Timing_Conversions. 
Convert_stu_to_numeric_interval ( 

stu => System_Defs.null_time) ) ; 

string_interval.sign := ' '; 
string_interval.days (7 ..8) := string_time.day; 



= "Jan" 
= "Feb" 
= "Mar" 
= "Apr" 
= "May" 
= "Jun" 
= "Jul" 
= "Aug" 
= "Sep" 
= "Oct" 
= "Nov" 
= "Dec" 
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string_interval . hours (11 .. 12) := string_time.hour; 

st ring_interval . minutes (11 .. 12) := string_time. minute; 

string_interval. seconds (11 .. 12) := string_time. second; 

st ring_interval. hundredths (11 .. 12) := string_time. hundredth; 

return Timing_Conversions . Convert_numeric_interval_to_stu ( 
num_interval => Timing_String_Conversions. 
Convert_string_interval_to_numeric( 

str_interval => string_interval) ) ; 
end if; 

exception 

when time_format_error => 
Message_Services.Write_msg( 

msg_id => time_format_error_code, 
paraml => Incident_Defs.message_parameter' ( 
typ => Incident_Defs.txt, 
len => Incident_Defs.txt_length, 
txt_val => hour_time) ) ; 
RAISE ; 

when day_format_error => 

Message_Services.Write_msg( 

msg_id => day_format_error_code, 
paraml => Incident_Defs.message_parameter' ( 
typ => Incident_Defs.txt, 
len => Incident_Def s. txt_length, 
txt_val => day_time) ) ; 
RAISE; 

end Parse time; 



CREATE_WAITING_PROCESS 

procedure Create_waiting_process ( 

invocation_record: program_record) 
is 

— Logic: 

Creates a new session, then a job in that session, 
and then the waiting process from that job. 



new_name: constant System_Defs.text (13) := 
(13, 13, "timed request"); 

job_info: Job_mgt. job_info (80) ; 

— SSO field used for creating new session 



new job AD: 



JobJTypes . job_AD; 



program_length: System. ordinal := System. ordinal ( 
invocation record' size / System. storage unit); 



begin 

— retrieves SSO for new session 
Job_Mgt . Get_ job_inf o ( 
info => job_info) ; 

new_job_AD := Job_Admin.Invoke_job ( 

init_proc => Wait_program' subprogram_value, 

param_buffer => invocation_record' address, 

param_length => program_length, 

text => new_name, 

session => Session_Mgt.create_session( 

SSO => job_info.SSO, 

session_name => new_name) ) ; 

end Create_waiting_process; 
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383 

384 procedure Wait_program{ 

385 param_buffer: System. Address; 

386 param_length: System. ordinal) 
387 

388 is 

389 

390 

391 use Long_Integer_Defs; 

392 — for system_time_units 
393 

394 

395 program_rec : program_record; 

396 FOR program_rec USE AT param_buf fer; 
397 

398 command_job_AD: Job_Types. job_Ad; 

399 

400 req_index: Timed_Requests_Mgt.request_index; 

401 

402 wait: Semaphore_Mgt . semaphore_AD := 

403 Semaphore_Mgt . Create_semaphore ( 

404 initial_count => 0) ; 

405 — create semaphore in locked state 

406 — blocks job until time specified 
407 

408 begin 
409 

410 — period must be non-null for 

411 — Timed_Requests_Mgt.Get_next_activation 

412 if program_rec.stu_period = System_Defs.null_time then 

413 program_rec.stu_period := System_Defs.stu_per_min; 

414 end if; 
415 

416 — Loop until count is expired or "until" time is 

417 — expired, whichever is first. Count and until both 

418 — have defaults of max_int. If period was not specified 

419 — the loop count was set to one by the driver 

420 while program_rec. stu_until >= program_rec. stu_start 

421 and program_rec. count > 

422 loop 

423 req_index := 

424 Timed_Requests_Mgt.Enter_request ( 

425 req_info => Timed_Requests_Mgt ,request_info ( 

426 Timed_Requests_Mgt . semaphore_signal) ' ( 

427 kind => Timed_Requests_Mgt . semaphore_signal, 

428 wakeup_time => program_rec. stu_start, 

429 from_when => Timed_Requests_Mgt .system_epoch, 

430 semaphore => wait) ) ; 
431 

432 — wait until Timed_Requests unlocks semaphore 

433 — NOTE: there is about a 3 second delay before the 

434 — command is actually run 

435 Semaphore_Mgt.P (semaphore => wait); 
436 

437 command_job_AD := 

438 Command_Execution.Run_program_or_script ( 

439 command => program_rec. command) ; 
440 

441 program_rec. count := program_rec . count - 1; 
442 

443 — NOTE1: This is an expensive call that should only be 

444 — used when slippage cannot be tolerated. 

445 — NOTE2: The call should be placed after command invocation. 

446 Timed_Requests_Mgt .Get_next_activation ( 

447 period => program_rec. stu_period, — this cannot be null 

448 next_activation => program_rec. stu_start) ; 
449 

450 end loop; 

451 

452 end Wait_program; 

453 

454 end At Support Ex; 
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X-A.6.4 Compiler_Ex Package Specification 

1 with Device_Defs; 

2 

3 package Compiler_Ex is 

4 

5 — Function: 

6 — Supplies the procedural interface a Pascal 

7 — compiler. 
8 

9 — This interface can be used to write the 

10 — compiler invocation script. End of Header 
11 

12 — History: 

13 — 08-10-87, Paul Schwabe: initial revision. 

14 — 12-02-87, Paul Schwabe: revision. 

15 pragma external; 
16 

17 procedure Compile_pascal ( 

18 source_code: Device_Defs. opened_device; 

19 — Opened on source code input file, with read 

20 — rights. 

21 machine_code: Device_Defs.opened_device; 

22 — Opened on machine code output file, with read 

23 — and write rights. 

24 listing: Device_Defs.opened_device) ; 

25 — Opened on listing output file, with write 

26 — rights. 
27 

28 — Function: 

29 — Compiles a Pascal program. 
30 

31 — Relies on the caller to handle user 

32 — interaction. 
33 

34 end Compiler_Ex; 
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X-A.6.5 Compiler_Ex Package Body 



1 with Byte_Stream_AM, 

2 Device_Defs f 

3 Event_Mgt , 

4 Pipe_Mgt, 

5 Process_Mgt, 

6 Process_Mgt_Types f 

7 System; 
8 

9 package body Compiler_Ex is 
10 

11 — Logic: 

12 — Speeds up a Pascal compiler by dividing parsing 

13 — and code generation between two processes 

14 — connected by a pipe. 
15 

16 — "Parse" and "Code_gen" are the initial 

17 — procedures of the two child processes. 
18 

19 — History: 

20 — 11-24-87, Paul Schwabe: Initial version. 

21 — 11-25-87, Gary Taylor : Added tagged comment lines. 
22 

23 — End of Header 

24 

25 

26 type connection_record is record 

27 — A "connection_record" contains the I/O 

28 — connections used by the two child processes. 

29 — The entire record is passed to both children. 
30 

31 source_code: Device_Def s.opened_device; 

32 — input file 

33 machine_code: Device_Defs.opened_device; 

34 — output file 

35 listing: Device_Defs.opened_device; 

36 — output file 

37 parse_out: Device_Defs.opened_device; 

38 — output to pipe 

39 code_gen_in: Device_Defs.opened_device; 

40 — input from pipe 

41 end record; 
42 

43 

44 procedure Parse ( 

45 param_buffer: System. address; 

46 — Address of connection record. 

47 param_length: System. ordinal) 

48 — Not used in this procedure, but required for 

49 — process's initial procedure. 
50 

51 — Logic: 

52 — Do Pascal parsing using the I/O connections 

53 — specified in the "conn_rec" parameter record. 

54 is 

55 conn_rec: connection_record; — Record containing 

56 — parameters. 

57 FOR conn_rec USE AT param_buf fer; 

58 begin 

59 — Code to parse "conn_rec. source_code" and write 

60 — parsed stream to "conn_rec.parse_out" and listing 

61 — to "conn_rec. listing" goes here. 

62 null; 

63 end Parse; 

64 pragma subprogram_value (Process_Mgt .Initial_proc, Parse); 
65 

66 

67 procedure Code_gen ( 

68 param_buffer: System. address; 

69 — Address of connection record. 

70 param_length: System. ordinal) 

71 — Not used but required for process's initial 

72 — procedure. 
73 

74 — Logic: 
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75 — Do Pascal code generation using the I/O 

76 — connections specified in the "conn_rec" 

77 — parameter record. 

78 is 

19 conn_rec: connect ion_record; 

80 — Record containing parameters. 

81 FOR conn_rec USE AT param_buf fer; 

82 begin 

83 — Code to read "conn_rec.code_gen_in", write 

84 — compiled code to n conn_rec.machine_code", and add 

85 — any needed messages to "cr. listing" goes here. 

86 null; 

87 end Code_gen; 

88 pragma subprogram_value ( 

89 Process_Mgt. Initial jproc, 

90 Code_gen) ; 
91 

92 

93 procedure Compile__pascal ( 

94 source_code: Device_Defs.opened_device; 

95 machine code; Device Defs. opened device; 

96 listing: Device_Defs.opened_device) 
97 

98 — Logic: 

99 

100 — 1. Create a pipe. 
101 

102 — 2. Create a record specifying all I/O 

103 — connections for child processes. Open both 

104 — ends of the pipe to create the pipe 

105 — connections needed. 
106 

107 — 3. Get an AD for this process from process 

108 — globals. 
109 

110 — 4. Spawn the parsing process. The parameter 

111 — buffer address is the connection record's 

112 — address. The termination action signals the 

113 — "user_l" event to this process. 
114 

115 — 5. Spawn the code generation process. The 

116 — parameter buffer address is the connection 

117 — record's address. The termination action 

118 — signals the "user_2" event to this process. 
119 

120 — 6. Wait for. both the n user_l" and "user_2" 

121 — events to be signalled indicating that both 

122 — child processes have terminated. 
123 

124 — 7. Deallocate both child processes. 
125 

126 =>- Notes: 

127 — No check is made for abnormal termination of 

128 — the child processes. 
129 

130 — Would like to deallocate pipe when done with it 

131 — but "Pipe_Mgt" does not provide a "Deallocate" 

132 — call. 

133 is 

134 compiler_pipe: Pipe_Mgt .pipe_AD; 

135 — Pipe that connects "Parse" and "Code_gen" 

136 — processes. 
137 

138 conn_rec: connection_record; 

139 — Record referencing all I/O connections used by 

140 — the child processes. 
141 

142 this_process_untyped: System. untyped_word; 

143 — Process executing call to "Compile_pascal", 

144 — as an "untyped_word". 
145 

146 parse_process: Process_Mgt_Types.process_AD; 

147 — Process executing "Parse". 
148 

149 code_gen_process: Process_Mgt_Types.process_AD; 

150 — Process executing "Code_gen". 
151 
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152 term_events: Event_Mgt .action_record_list (2) ; 

153 — Array that receives termination events of the 

154 — two child processes. 
155 

156 begin 

157 compilerjpipe := Pipe_Mgt .Create_pipe; 
158 

159 conn_rec := ( 

160 source_code => source_code, 

161 machine_code => machine_code, 

162 listing => listing, 

163 parse_out => Byte_Stream_AM.Ops.Open ( 

164 Pipe_Mgt.Convert_pipe_to_device ( 

165 compiler_pipe) , 

166 Device_Def s. output ) , 

167 code_gen_in => Byte_Stream_AM. Ops. Open ( 

168 Pipe_Mgt.Convert_pipe_to_device ( 

169 compiler_pipe) , 

170 Device_Defs. input) ) ; 
171 
172 
173 



this_process_untyped := 

Process_Mgt .Get_process_globals_entry ( 
Process Mat Tvoes.nrocess) ; 



x i *i c j-w^coo n^v^iUCL ^xw^cao ^j.ujm'CIJ. 

174 Process_Mgt_Types. process) 
175 

176 parse_process := Process_Mgt .Spawn_process ( 

177 init_proc => Parse' subprogram_value, 

178 param_buffer => conn_rec' address, 
17 9 term_action => ( 

180 event => Event_Mgt .user_l, 

181 message => System. null_address, 

182 destination => this_process_untyped) ) ; 
183 

184 code_gen_process := Process_Mgt .Spawn_process ( 

185 init_proc => Code_gen' subprogram_value, 

186 param_buffer => conn_rec' address, 

187 term_action => ( 

188 event => Event_Mgt .user_2, 

189 message => System. null_address, 

190 destination => this_process_untyped) ) ; 
191 

192 Event_Mgt.Wait_for_all ( 

193 events => 

194 (Event_Mgt.user_l .. Event_Mgt .user_2 => 

195 true, 

196 others => false), 

197 action_list => term_events) ; 
198 

199 — These process are terminated so 

200 — "Deallocate" should work. 

201 Process_Mgt .Deallocate (parse_process) ; 

202 Process_Mgt .Deallocate (code_gen_process) ; 
203 

204 end Compile_pascal; 

205 

206 

207 end Compiler Ex; 
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X-A.6.6 Conversion_Support_Ex Package Specification 

1 with Attribute_Mgt, 

2 Authority_List_Mgt, 

3 Data_Definition_Mgt, 

4 Device_Defs, 

5 Directory_Mgt, 

6 Event_Mgt , 

7 File_Defs, 

8 Identification_Mgt, 

9 Identification_Mgt, 

10 Job_Types, 

1 1 Name_Space_Mgt , 

12 Object_Mgt, 

13 Object_Mgt, 

14 Passive_Store_Mgt, 

15 Pipe_Mgt, 

16 Process_Mgt_Types, 

17 Session_Types, 

18 System_Defs, 

19 System, 

20 Unchecked_conversion; 
21 

22 package Conversion_Support_Ex is 
23 

24 — Function: 

25 — Provides commonly needed compile-time type 

26 — conversions for OS access types. 
27 

28 — Some OS calls can operate on many different 

29 — object types. Such calls require or return 

30 — values of type "System. untyped_word", used to 

31 — hold any AD. If your application uses ADs with 

32 — more specific types, you must convert those 

33 — types to and from "System. untyped_word". For 

34 — example, to store an AD to a Type Definition 

35 — Object in a directory, you must convert from 

36 — the type "Object_Mgt .TDO_AD" to 

37 — "System. untyped_word" . 
38 

39 — All the conversion routines in this package are 

40 — instantiations of the "Unchecked_conversion" 

41 — generic Ada function. Calls to the conversion 

42 — routines are processed at compile-time, and 

43 — have no runtime cost. 
44 

45 — There are a few conversions that don't require 

4 6 — using a conversion routine. For example, 

47 — "Device_Defs. device" is a subtype of 

48 — "System. untyped_word" . This package still 

49 — provides the expected conversion routines — they 

50 — have no runtime cost, and by using them you do 

51 — not have to remember which types don't require 

52 -- conversion. 
53 

54 — The conversion function names have the form 

55 — "X_from_Y" where "X" indicates the result type 

56 — and "Y" indicates the source type. 
57 

58 — History: 

59 — 06-03-87, Martin L. Buchanan: Initial version. 

60 — 06-09-87, Paul Schwabe: Added full set of 

61 — unchecked_conversions . 

62 — 11-23-87, Paul Schwabe: Fixed line sizes. 
63 

64 — End of Header 

65 pragma external; 
66 

67. function Attribute_ID_from_untyped is new 

68 Unchecked_conversion ( 

69 source => System. untyped_word, 

70 target => Attribute_Mgt .attribute_ID_AD) ; 
71 

72 

73 function Untyped_from_attribute_ID is new 

74 Unchecked conversion ( 
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source => Attribute_Mgt.attribute_ID_AD, 
target => System. untyped_word) ; 



function Authority_list_from_untyped is new 
Unchecked_conversion ( 

source => System. untyped_word, 
target => Authority_List_Mgt. 
authority_list_AD) ; 



function Untyped_from_authority_list is new 
Unchecked_conversion ( 

source => Authority_List_Mgt . 

authority_list_AD, 
target => System. untyped_word) ; 



function DDef_from_untyped is new 
Unchecked_conversion ( 

source => System. untyped_word, 

target => Data_Definition_Mgt .DDef_AD) 



function Untyped_from_DDef is new 
Unchecked_conversion ( 

source => Data_Definition_Mgt .DDef_AD, 
target => System. untyped word); 



function Device_from_untyped is new 
Unchecked_conversion ( 

source => Device_Defs. device, 
target => Authority_List_Mgt . 
authority list AD) ; 



function Untyped_from_device is new 
Unchecked_conversion ( 

source => Authority_List_Mgt . 

authority_list_AD, 
target => Device Defs. device) ; 



function Opened_device_from_untyped is new 
Unchecked_conversion ( 

source => System. untyped_word, 
target => Device Defs. opened device) 



function Untyped_from_opened_device is new 
Unchecked_conversion ( 

source => Device_Defs.opened_device, 
target => System. untyped word); 



function Directory_from_untyped is new 
Unchecked_conversion ( 

source => System. untyped_word, 
target => Directory_Mgt. directory _AD) 



function Untyped_from_directory is new 
Unchecked_conversion ( 

source => Directory _Mgt.directory_AD, 
target => System. untyped word); 



function Event_cluster_from_untyped is new 
Unchecked_conversion ( 

source => System. untyped_word, 
target => Event_Mgt . event cluster_AD) 



function Untyped_from_event_cluster is new 
Unchecked_conversion ( 

source => Event Mgt. event cluster AD, 
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152 target => System. untyped_word) ; 

153 

154 

155 function File_from_untyped is new 

156 Unchecked_conversion ( 

157 source => System. untyped_word, 

158 target => File_Defs.file_AD) ; 
159 

160 

161 function Untyped_from_file is new 

162 Unchecked_conversion ( 

163 source => File_Defs.file_AD, 

164 target => System. untyped_word) ; 
165 

166 

167 function ID_from_untyped is new 

168 Unchecked_conversion ( 

169 source => System. untyped_word, 

170 target => Identification_Mgt.ID_AD) ; 
171 

172 

173 function Untyped_from_ID is new 

174 Unchecked_conversion ( 

175 source => Identification_Mgt.ID_AD, 

176 target => System. untyped_word) ; 
177 

178 

179 function ID_list_from_untyped is new 

180 Unchecked_conversion ( 

181 source => System. untyped_word, 

182 target => Identification_Mgt .ID_list_AD) 
183 

184 

185 function Untyped_from_ID_list is new 

186 Unchecked_conversion ( 

187 source => Identification_Mgt .ID_list_AD, 

188 target => System. untyped_word) ; 
189 

190 

191 function Job_from_untyped is new 

192 Unchecked_conversion ( 

193 source => System. untyped_word, 

194 target => Job_Types. job_AD) ; 
195 

196 

197 function Untyped_from_job is new 

198 Unchecked_conversion ( 

199 source => Job_Types. job_AD, 

200 target => System. untyped_word) ; 
201 

202 

203 function Name_space_from_untyped is new 

204 Unchecked_conversion ( 

205 source => System. untyped_word, 

206 target => Name_Space_Mgt .name_space_AD) ; 
207 

208 

209 function Untyped_from_name_space is new 

210 Unchecked_conversion( 

211 source => Name_Space_Mgt .name_space_AD, 

212 target => System. untyped_word) ; 
213 

214 

215 function SRO_from_untyped is new 

216 Unchecked_conversion ( 

217 source => System. untyped_word, 

218 target => Object_Mgt . SRO_AD) ; 
219 

220 

221 function Untyped_from_SRO is new 

222 Unchecked_conversion ( 

223 source => Object_Mgt.SRO_AD, 

224 target => System. untyped_word) ; 
225 

226 

227 function TDO_from_untyped is new 

228 Unchecked conversion { 
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229 source => System. untyped_word, 

230 target => Object_Mgt.TDO_AD) ; 
231 

232 

233 function Untyped_from_TDO is new 

234 Unchecked_conversion ( 

235 source => Object_Mgt .TDO_AD, 

236 target => System. untyped_word) ; 
237 

238 

239 function PSM_attributes_from_untyped is new 

240 Unchecked_conversion ( 

241 source => System. untyped_word, 

242 target => Passive_Store_Mgt. 

243 PSM_attributes_AD) ; 
244 

245 

24 6 function Untyped_from_PSM_attributes is new 

247 Unchecked_conversion ( 

248 source => Passive_Store_Mgt . 

249 PSM_attributes_AD, 

250 target => System. untyped_word) ; 
251 

252 

253 function Pipe_from_untyped is new 

254 Unchecked_conversion ( 

255 source => System. untyped_word, 

256 target => Pipe_Mgt.pipe_AD) ; 
257 

258 

259 function Untyped_from_pipe is new 

260 Unchecked_conversion ( 

261 source => Pipe_Mgt .pipe_AD, 

262 target => System. untyped_word) ; 
263 

264 

265 function Process_from_untyped is new 

266 Unchecked_conversion ( 

267 source => System. untyped_word, 

268 target => Process_Mgt_Types.process_AD) 
269 

270 

271 function Untyped_from_process is new 

272 Unchecked_conversion ( 

273 source => Process_Mgt_Types.process_AD, 

274 target => System. untyped_word) ; 
275 

276 

277 function Session_from_untyped is new 

278 Unchecked_conversion ( 

279 source => System. untyped_word, 

280 target => Session_Types. session_AD) ; 
281 

282 

283 function Untyped_from_session is new 

284 Unchecked_conversion ( 

285 source => Session_Types. session_AD, 

286 target => System. untyped_word) ; 
287 

288 

289 function Text_from_untyped is new 

290 Unchecked_conversion ( 

291 source => System. untyped_word, 

292 target => System_Defs.text_AD) ; 
293 

294 

295 function Untyped_from_text is new 

296 Unchecked_conversion ( 

297 source => System_Defs.text_AD, 

298 target => System. untyped_word) ; 
299 

300 

301 end Conversion Support Ex; 
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X-A.6.7 Memory ex Procedure 



1 with Object_Mgt, 

2 LongJEnteger = Defs, 

3 SRO_Mgt, 

4 System_Defs; 
5 

6 procedure Memory_ex 
7 

8 — Function: 

9 — Provide examples of several memory management 
10 — programming techniques. 

11 

12 is 

13 — Declare a record for a job' s memory 

14 — information: 
15 

16 job_memory_info: SRO_Mgt.SRO_information; 

17 begin 
18 

19 — Get current memory information for the calling 

20 — job: 
21 

22 job_memory_info := SR0_Mgt .Read_SRO_information; 

23 

24 

25 — Shrink the calling process' s stack to the 

26 — size currently used. The stack can still 

27 — grow and will be expanded as needed. 
28 

29 Object_Mgt.Trim_stack; 

30 

31 

32 — Force a local garbage collection run to start 

33 — immediately in the calling job: 
34 

35 SRO_Mgt.Start_GCOL; 

36 

37 

38 — Configure a local garbage collection daemon 

39 — to run in the calling job when it has used 

40 — 50% of its storage claim OR 50% of its object 

41 — table page claim, AND at least 5 minutes 

42 — has elapsed since a previous local GCOL run 

43 — in the job. 
44 

45 SRO_Mgt . Start_GCOL ( 

46 storage_claim_percent => 50, 

47 OTP_claim_percent => 50, 

48 minimum_delay => 

49 Long_Integer_Defs. "*"( 

50 Long_Integer_Defs. long_integer' (0, 5), 

51 System_Def s. stu_per_min) ) ; 
52 

53 

54 — Kill any local garbage collection daemon in 

55 — the calling job. (Does nothing if there 

56 — is no daemon.) 
57 

58 SRO_Mgt.Start_GCOL(0, 0, Long_Integer_Def s.max_int) 

59 

60 end Memory ex; 
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X-A.6.8 Process__Giobals_Support_Ex Package Specification 

1 with Authority_List_Mgt, 

2 Device_Defs, 

3 Di rectory _Mgt, 

4 Identification_Mgt, 

5 Job_Types, 

6 Name_Space_Mgt, 

7 Process_Mgt_Types, 

8 Session_Types, 

9 System_Defs; 
10 

11 package Process_Globals_Support_Ex is 
12 

13 — Function: 

14 — Provide calls to get and set commonly used 

15 — process globals entries, for the calling 

16 — process. 
17 

18 — See "Process_Mgt_Types" for descriptions of all 

19 — process globals entries. 
20 

21 

22 — « What You Get with This Package » 

23 

24 — There are three advantages to using this 

25 — package, as compared to using the "Process_Mgt" 

26 — calls to get and set process globals: 
27 

28 — 1. The underlying calls require or return 

29 — untyped words. You must instantiate 

30 — "Unchecked_conversion" to convert to and from 

31 — the types you actually need, such as 

32 — "Device_Defs.opened_device" . 
33 

34 — 2. You don't have to supply a value of type 

35 — "Process_Mgt_Types.process_globals_entry" that 

36 — specifies the process globals *slot* you are 

37 — manipulating. 
38 

39 — 3. The underlying calls can be used to stuff 

40 — garbage into process globals entries and later 

41 — return that garbage. The calls in this 

42 — package do reasonable checks on type, rights, 

43 — and object state for the modifiable process 

44 — globals entries. Such checks aren't needed for 

45 — the non-modifiable entries, assigned by 
4 6 — the OS. 

47 

48 

49 — « What You Don't Get with This Package » 

50 

51 — This package does not support assigning or 

52 — retrieving null values for the modifiable 

53 — process globals entries. You can assign and 

54 — retrieve null values for these entries using 

55 — "Process_Mgt" calls. 
56 

57 — This package does not support getting or 

58 — setting another process's globals. You can 

59 — access another process's globals by using 

60 — "Process_Mgt n or "Process_Admin" calls. 
61 

62 — This package does not support setting any 

63 — process globals entries that can only be set by 

64 — an administrative interface, such as 

65 — "Process_Admin" . 
66 

67 — This package is selective, and does not provide 

68 — calls to get or set every publicly accessible 

69 — entry. 
70 

71 — Exceptions: 

72 — user_dialog_not_interactive 
73 

74 
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75 — History: 

76 — 06-03-87, Martin L. Buchanan: Initial version. 

77 — 11-23-87, Paul Schwabe: Updated spec. 
78 

79 — End of Header 

80 pragma external; 
81 

82 function Get_standard_input 

83 return Device_Defs.opened_device; 

84 — The calling process's standard 

85 — input opened device, 

86 — open and with read rights. 
87 

88 — Function: 

89 — Returns the calling process's standard input. 
90 

91 — Exceptions: 

92 — Device_Defs.device_not_open - 

93 — The opened device has been closed. 
94 

95 

96 procedure Set_standard__input ( 

97 opened_dev: Device_Defs.opened_device) ; 

98 — Opened device, open and with read rights. 
99 

100 — Function: 

101 — Assigns the calling process's standard input. 
102 

103 — Exceptions: 

104 — Device_Defs.device_not_open - 

105 — The opened device has been closed. 
106 

107 

108 function Get_standard_output 

109 return Device_Defs.opened_device; 

110 — The calling process's standard 

111 — output opened device, 

112 — open and with write rights. 
113 

114 — Function: 

115 — Returns the calling process's standard output. 
116 

117 — Exceptions: 

118 — Device_Defs.device_not_open - 

119 — The opened device has been closed. 
120 

121 

122 procedure Set_standard_output ( 

123 opened_dev: Device_Def s.opened_device) ; 

124 — Opened device, open and with write rights. 
125 

126 — Function: 

127 — Assigns the calling process's standard output. 
128 

129 — Exceptions: 

130 — Device_Def s.device_not_open - 

131 — The opened device has been closed. 
132 

133 

134 function Get_standard_message 

135 return Device_Def s.opened_device; 

136 — The calling process's standard 

137 — message opened device, 

138 — open and with write rights. 
139 

140 — Function: 

141 — Returns the calling process's standard message 

142 — opened device. 
143 

144 — Exceptions: 

145 — Device_Defs.device_not_open - 

146 — The opened device has been closed. 
147 

148 

149 procedure Set_standard_message ( 

150 opened_dev: Device_Defs.opened_device) ; 

151 — Opened device, open and with write rights. 
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Function: 

Assigns the calling process's standard 
message opened device. 

Exceptions : 

Device_Defs.device_not_open - 

The opened device has been closed. 



function Get_user_dialog 

return Device_Def s.opened_device; 

— The calling process's user 

— dialog opened device, open, with the 

— "is_interactive" flag set in the 

— underlying device's information record, 

— and with both read and write rights. 

— Function: 

Returns the calling process's 

— user dialog opened device. 

— Exceptions: 

Device_Defs.device_not_open - 

The opened device has been closed. 



procedure Set_user_dialog( 

opened_dev: Device_Defs.opened_device) ; 

An opened device that is open, with the 
"is_interactive" flag set in the underlying 
device's information record, and with both 
read and write rights. 

— Function: 

Assigns the calling process's user dialog 

— opened device. 

— Exceptions: 

Device_Defs.device_not_open - 

The opened device has been closed. 



function Get_home_di rectory 

return Directory _Mgt. directory _AD; 

— The calling process's home directory. 

— Function: 

Returns the calling process's home directory. 

— Notes: 

Setting a process's home directory is an 
administrative operation. 



function Get_current_directory 

return Directory_Mgt. directory _AD; 

— The calling process's current directory. 

— Function: 

Returns the calling process's current 
directory. 



procedure Set_current_directory ( 
dir: Directory_Mgt. directory _AD) ; 
— Any directory. 

— Function: 

— Assigns the calling process's current 
directory. 



function Get_authority_list 

return Authority_List_Mgt .authority_list_AD; 
— The calling process's authority list. 
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229 — Function: 

230 — Returns the calling process's authority list. 
231 

232 

233 procedure Set_authority_list ( 

234 auth: Authority_List_Mgt.authority_list_AD) ; 

235 — Any authority list. 
236 

237 — Function: 

238 — Assigns the calling process's default 

239 — authority list. 
240 

241 

242 function Get_ID_list 

243 return Identification_Mgt.ID_list_AD; 

244 — The calling process's ID list. 
245 

246 — Function: 

247 — Returns the calling process's ID list. 
248 

249 — Notes: 

250 — Setting a process's ID list is an 

251 — administrative operation. 
252 

253 

254 function Get_command_name_space 

255 return Name_Space_Mgt .name_space_AD; 

256 — The calling process's command name space. 
257 

258 — Function: 

259 — Returns the calling process's command name 

260 — space. 
261 

262 

263 procedure Set_command_name_space ( 

264 n s : Name_Space_Mgt . name_space_AD ) ; 

265 — Any name space. 
266 

267 — Function: 

268 — Assigns the calling process's command name 

269 — space. 
270 

271 

272 function This_process 

273 return Process_Mgt_Types.process_AD; 

274 — The calling process, with control rights. 
275 

276 — Function: 

277 — ■ Returns the calling process. 
278 

279 

280 function Get_parent_process 

281 return Process_Mgt_Types.process_AD; 

282 — Parent process of the calling process, with 

283 — control rights. Null if the calling 

284 — process is the initial process of its job. 
285 

286 — Function: 

287 — Returns the calling process's parent process, 

288 — if any. 
289 

290 

291 function This_job 

292 return Job_Types. job_AD; 

293 — Job that contains the calling process, with 

294 — list and control rights. 
295 

296 — Function: 

297 — Returns the calling job. 
298 

299 

300 function This_session 

301 return Session_Types. session_AD; 

302 - — Session that contains the calling job, with 

303 — list and control rights. 
304 

305 — Function: 
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306 — Returns the caller's session. 

307 

308 

309 function Get_jprocess_name 

310 return System_Defs.text_AD; 

311 — AD to text record containing the calling 

312 — process's name. 
313 

314 — Function: 

315 — Returns the calling process's symbolic name. 
316 

317 — The symbolic name may be a null text record. 

318 

319 

320 procedure Set_process_name ( 

321 name: System_Def s.text) ; 

322 — A text record containing a name for the 

323 — process. The text record must be valid, 

324 — with a "length" field less than or equal 

325 — to its "max_length" field. 
326 

327 — Function: 

328 — Assigns the calling process's symbolic name. 
329 

330 — Exceptions: 

331 — System_Exceptions.bad_parameter 
332 

333 

334 end Process Globals Support Ex; 
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X-A.6.9 Process_Globals_Support__Ex Package Body 

1 with Access_Mgt, 

2 Authority_List_Mgt, 

3 Byte_Stream_AM, 

4 Device_Defs, 

5 Di rectory _Mgt, 

6 Identification_Mgt, 

7 Job_Mgt, 

8 JobJTypes, 

9 Name_Space_Mgt , 

10 Process_Mgt, 

11 Process_Mgt_Types, 

12 Session_Mgt, 

13 Session_Types, 

14 System_Defs, 

15 System_Exceptions, 

16 System; 
17 

18 package body Process_Globals_Support_Ex is 
19 

20 — Function: 

21 — Provide calls to get and set commonly used 

22 — process globals entries, for the calling 

23 — process. 
24 

25 — History: 

26 — 06-10-87, Paul Schwabe: Initial version. 

27 — 11-24-87, Paul Schwabe: Updated version. 

28 — 11-25-87, Gary Taylor : Added tagged comment lines. 
29 

30 — End of Header 

31 

32 

33 function Get_standard_input 

34 return Device_Defs.opened_device 
35 

36 — Logic: 

37 — 1. Get the process globals entry. 

38 — 2. Check that the standard input is open, 

39 — which implicitly checks that its an opened 

40 — device. 

41 — 3. Check that the standard input has 

42 — read rights. 

43 — 4. Return the standard input. 

44 is 

45 stdin: Device_Def s.opened_device; 

46 stdin_untyped: System. untyped_word; 

47 FOR stdin_untyped USE AT stdin' address; 

48 begin 

49 stdin_untyped := Process_Mgt. 

50 Get_process_globals_entry ( 

51 Process_Mgt_Types. standard_input) ; 
52 

53 if not By te_Stream_AM.eps. I s_open (stdin) then 

54 RAISE Device_Defs.device_not_open; 
55 

56 elsif not Access_Mgt. Permits ( 

57 AD => stdin_untyped, 

58 rights => Device_Defs.read_rights) then 

59 RAISE System_Exceptions.insufficient_type_rights; 
60 

61 else 

62 RETURN stdin; 
63 

64 end if; 

65 end Get_standard_input; 
66 

67 

68 procedure Set_standard_input ( 

69 opened_dev: Device_Defs.opened_device) 
70 

71 — Logic: 

72 — 1= Check that the new standard input is open, 

73 — which implicitly checks that its an opened 

74 — device. 
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2. Check that that the new standard 
— input has read rights. 

3. Set the new standard input, 
is 

stdin_untyped: System. untyped_word; 

FOR stdin_untyped USE AT opened_dev' address ; 
begin 

if not Byte_Stream_AM.Ops.Is_open(opened_dev) then 

RAISE Device_Def s .device_not_open; 

elsif not Access_Mgt. Permits ( 
AD => stdin_untyped, 
rights => Device_Defs.read_rights) then 
RAISE System_Exceptions . insuf f icient_type_rights; 

else Process_Mgt.Set_process_globals_entry ( 

slot => Process_Mgt_Types.standard_input, 
value => stdin_untyped) ; 

end if; 

end Set standard input; 



function Get_standard_output 

return Device_Def s.opened_device 

— Logic: 

1. Get the process globals entry. 

2. Check that the new standard output is open, 
which implicitly checks that its an opened 

— device. 

3. Check that the standard output has 
read rights. 

4. Return the new standard output, 
is 

stdout : Device_Defs.opened_device; 

stdout_untyped: System. untyped_word; 

FOR stdout_untyped USE AT stdout' address; 
begin 

stdout_untyped := Process_Mgt. 
Get_process_globals_entry ( 

Process_Mgt_Types. standard_output) ; 

if not Byte_St ream_AM. Ops. I s_open (stdout) then 
RAISE Device_Defs.device_not_open; 

elsif not Access_Mgt .Permits ( 
AD => stdout_untyped, 
rights => Device_Defs.write_rights) then 
RAISE System_Exceptions. insuf ficient_type_rights; 

else 

RETURN stdout; 

end if; 
end Get_standard_output; 



procedure Set_standard_output ( 

opened_dev : Devi ce_De f s . opened_devi ce ) 

Logic: 

— 1. Check that the new standard output is 

open, which implicitly checks that its an 
opened device. 

— 2. Check that that the new standard output 

has write rights. 
3. Set the new standard output, 
is 

stdout_untyped: System. untyped_word; 
FOR stdout_untyped USE AT 
opened_dev' address; 
begin 

if not Byte_Stream_AM.Ops.Is_open (opened_dev) then 
RAISE Device Defs. device not open; 
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152 elsif not Access_Mgt .Permits ( 

153 AD => stdout_untyped, 

154 rights => Device_Defs.write_rights) then 

155 RAISE System_Exceptions.insufficient_type_rights; 
156 

157 else Process_Mgt .Set_process_globals_entry ( 

158 slot => Process_Mgt_Types.standard_output, 

159 value => stdout_untyped) ; 

160 end if; 
161 

162 end Set_standard_output; 

163 

164 

165 function Get_standard_message 

166 return Device_Def s.opened_device 
167 

168 — Logic: 

169 — 1. Get the process globals entry. 

170 — 2. Check that the standard message 

171 — output is open, which implicitly 

172 == checks that its an opened device. 

173 — 3. Check that the standard message 

174 — output has write rights. 

175 — 4. Return the standard message output. 

176 is 

177 stdmsg: Device_Defs.opened_device; 

178 stdmsg_untyped: System. untyped_word; 

179 FOR stdmsg_untyped USE AT 

180 stdmsg' address; 

181 begin 

182 stdmsg_untyped := Process_Mgt. 

183 Get_process_globals_entry ( 

184 Process_Mgt_Types.standard_message) ; 
185 

186 if not Byte_Stream_AM.Ops.Is_open (stdmsg) then 

187 RAISE Device_Defs.device_not_open; 
188 

189 elsif not Access_Mgt .Permits ( 

190 AD => stdmsg_untyped, 

191 rights => Device_Defs.write_rights) 

192 then 

193 RAISE System_Exceptions.insufficient_type_rights; 
194 

195 else 

196 RETURN stdmsg; 
197 

198 end if; 

199 end Get_standard_message; 
200 

201 

202 procedure Set_standard_message ( 

203 opened_dev: Device_Def s.opened_device) 
204 

205 — Logic: 

206 — 1. Check that the new standard message 

207 — output is open, which implicitly checks 

208 — that its an opened device. 

209 — 2. Check that that the new standard 

210 — message has write rights. 

211 — 3. Set the new standard message output. 

212 is 

213 stdmsg_un typed: System. untyped_word; 

214 FOR stdmsg_untyped USE AT 

215 opened_dev' address; 

216 begin 

217 if not Byte_Stream_AM.Ops.Is_open (opened_dev) then 

218 RAISE Device_Defs.device_not_open; 
219 

220 elsif not Access_Mgt .Permits ( 

221 AD => stdmsg_untyped, 

222 rights => Device_Defs.write_rights) then 

223 RAISE System_Exceptions.insuf ficient_type_rights; 
224 

225 else Process_Mgt .Set_process_globals_entry ( 

226 slot => Process_Mgt_Types.standard_message, 

227 value => stdmsg_untyped) ; 

228 end if; 
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end Set standard message; 



function Get_user_dialog 

return Device_Defs.opened_device 

— Logic: 

1. Get the process globals entry. 

2. Check that the user dialog is open, 
which implicitly checks that its an 
opened device. 

3. Check that the user dialog has 

— read and write rights. 

4. Return the user dialog. 
is 

user_dialog: Device_Defs.opened_device; 
user_dialog_untyped: System. untyped_word; 
FOR user_dialog_untyped USE AT 
user_dialog' address; 
begin 

user_dialog_untyped := Process_Mgt. 
Get_process_globals_entry ( 

Process_Mgt_Types.user_dialog) ; 

if not Byte_Stream_AM.eps. Is_open (user_dialog) then 
RAISE De vice_Defs.de vice_not_open; 

elsif not Access_Mgt .Permits ( 

AD => user_dialog_untyped, 

rights => Device_Defs.read_write_rights) 

then 

RAISE System_Exceptions.insuf ficient_type_rights; 

else 

RETURN user_dialog; 

end if; 

end Get user_dialog; 



procedure Set_user_dialog( 

opened_dev: Device_Defs.opened_device) 

Logic: 

1. Check that the new user_dialog is open, 
which implicitly checks that its an opened 
device. 

2. Check that that the new user dialog has 
— read and write rights. 

3. Set the new standard message. 
is 

user_dialog_untyped: System. untyped_word; 
FOR user_dialog_untyped USE AT 
opened_dev' address; 
begin 

if not Byte_Stream_AM.Ops.Is_open (opened_dev) then 
RAISE Device_Def s . device_not_open; 

elsif not Access_Mgt .Permits ( 

AD => user_dialog_untyped, 

rights => Device_Defs.read_write_rights) 

then 

RAISE System_Exceptions.insufficient_type_rights; 

else Process_Mgt .Set_process_globals_entry ( 
slot => Process_Mgt_Types.user_dialog, 
value => user_dialog_untyped) ; 

end if; 

end Set_user_dialog; 



function Get_home_directory 

return Directory _Mgt . directory _AD 
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— Logic: 

1. Get the process globals entry for 
the "home directory." 

2. Check that the entry is a 
directory. 

3. Check that directory has read rights. 

4. Return the directory, 
is 

dir: Directory_Mgt. directory _AD; 
dir_untyped: System. untyped_word; 
FOR dir_untyped USE AT 
dir' address; 
begin 

dir_untyped := Process_Mgt. 

Get _jprocess_globals_entry ( 

Process_Mgt_Types.home_dir) ; 

if not Directory _Mgt .Is_directory (dir_untyped) then 
RAISE System_Exceptions. type_mismatch; 

else 

RETURN dir; 

end if; 

end Get_home_di rectory; 



function Get_current_directory 

return Directory _Mgt. directory _AD 

— Logic: 

1. Get the process globals entry. 

2. Check that the "current directory" 

— is a directory. 

3. Return the current directory, 
is 

dir: Directory _Mgt .directory_AD; 
dir_untyped: System. untyped_word; 
FOR dir_untyped USE AT dir' address; 
begin 

dir_untyped := Process_Mgt. 

Get_process_globals_entry ( 

Process_Mgt_Types.current_dir) ; 

if not Directory _Mgt . Is_directory (dir_untyped) then 
RAISE System_Exceptions.type_mismatch; 

else 

RETURN dir; 

end if; 

end Get_current_directory; 



procedure Set_current_directory ( 
dir: Directory _Mgt. directory _AD) 

Logic: 
— 1. Check that the "current directory" is 
a directory. 
2. Set the new current directory. 
is 

dir_untyped: System. untyped_word; 
FOR dir_untyped USE AT dir' address; 
begin 

if not Directory _Mgt. I s_directory (dir_untyped) then 
RAISE System_Exceptions.type_mismatch; 

else Process_Mgt .Set_process_globals_entry { 
slot => Process_Mgt_Types.current_dir, 
value => dir_untyped) ; 

end if; 

end Set current directory; 
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function Get_authority_list 

return Authority_List_Mgt . authority_list_AD 

— Logic: 

1. Get the process globals entry. 

2. Check that the entry is an authority list. 

3. Return the authority list, 
is 

auth_list : Authority_List_Mgt . authority_list_AD; 
auth_list_untyped: System. untyped_word; 

FOR auth_list_untyped USE AT auth_list' address; 
begin 

auth_list_untyped := Process_Mgt. 
Get_process_globals_entry ( 

Process_Mgt_Types.authority_list) ; 

if not Authority_List_Mgt. 

Is_authority_list (auth_list_untyped) then 
RAISE System_Exceptions.type_mismatch; 

else 

RETURN auth_list; 

end if; 

end Get authority list; 



procedure Set_authority_list ( 

auth: Authority_List_Mgt.authority_list_AD) 

— Logic: 

1. Check that "auth" is an authority list, 

— 2. Set the new authority list, 
is 

auth_untyped: System. untyped_word; 
FOR auth_untyped USE AT auth' address; 
begin 

if not Authority_List_Mgt.Is_authority_list ( 
auth_untyped) then 
RAISE System_Exceptions.Type__mismatch; 

else Process_Mgt.Set_process_globals_entry ( 

slot => Process_Mgt_Types.authority_list, 
value ==> auth_untyped) ; 

end if; 

end Set_authority_list; 



function Get_ID_list 

return Identification_Mgt.ID_list_AD 

— Logic: 

1. Get the process globals entry. 

2. Check that the entry is an ID list. 
3= Return the ID list entry. 

is 

ID_list: Identification_Mgt.ID_list_AD; 
ID_list_untyped: System. untyped_word; 

FOR ID_list_untyped USE AT ID_list' address; 
begin 

ID_list_untyped := Process_Mgt. 
Get_process_globals_entry ( 

Process_Mgt_Types.ID_list) ; 

if not Identification_Mgt . 

Is_ID_list (ID_list_untyped) then 
RAISE System_Exceptions. type_mismatch; 

else 

RETURN ID_list; 

end if; 

end Get ID list; 
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460 
461 

462 function Get_command_name_space 

463 return Name_Space_Mgt . name_space_AD 

464 __ 

465 — Logic: 

466 — 1. Get the process globals entry. 

467 — 2. Check that the entry is a name space. 

468 — 3. Return the name space entry. 

469 is 

470 cmd_name_space : Name_Space_Mgt . 

471 name_space_AD ; 

472 cmd_name_space_untyped: System. untyped_word; 

473 FOR cmd_name_space_untyped USE AT 

474 cmd_name_space' address; 

475 begin 

476 cmd_name_space_untyped := Process_Mgt. 

477 Get_process_globals_entry ( 

478 Process_Mgt_Types.cmd_name_space) ; 
479 

480 if not Name_Space_Mgt . 

481 Is_name_space (cmd_name_space_untyped) then 

482 RAISE System_Exceptions.type_mismatch; 
483 

484 else 

485 RETURN cmd_name_space; 
486 

487 end if; 

488 

489 end Get_command_name_space; 

490 

491 

492 procedure Set_command_name_space ( 

493 ns : Name_Space_Mgt . name_space_AD ) 
494 

495 — Logic: 

496 — 1. Check that "ns" is a name space. 

497 — 2. Set the new command name space. 

498 is 

499 ns_untyped: System. untyped_word; 

500 FOR ns_untyped USE AT 

501 ns' address; 

502 begin 

503 if not Name_Space_Mgt . 

504 Is_name_spaee (ns_untyped) then 

505 RAISE System_Exceptions.type_mismatch; 
506 

507 else Process_Mgt .Set_process_globals_entry ( 

508 slot => Process_Mgt_Types.cmd_name_space, 

509 value => ns_untyped) ; 

510 end if; 
511 

512 end Set_command_name_space; 
513 

514 function This_process 

515 return Process_Mgt_Types.process_AD 
516 

517 — Logic: 

518 — 1. Get the process globals entry 

519 — for the current process. 

520 — 2. Return the process. 

521 is 

522 current_process: Process_Mgt_Types.process_AD; 

523 eurrent_proeess_untyped: System. untyped_word; 

524 FOR current_process_untyped USE AT 

525 current_process' address; 

526 begin 

527 current_process_untyped := Process_Mgt. 

528 Get_process_globals_entry ( 

529 Process_Mgt_Types. process) ; 
530 

531 RETURN current_process; 

532 

533 end This_process; 

534 

535 function Get_parent_process 

536 return Process Mgt Types. process AD 
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— Logic: 

1. Get the process globals entry 
for the parent process. 

2. Return the parent process. 



is 

parent_process: Process_Mgt_Types. 

process_AD; 
parent_process_untyped: System. untyped_word; 
FOR parent_process_untyped USE AT 
parent_process' address; 
begin 

parent_process_untyped := Process_Mgt. 
Get_process_globals_entry ( 

Process_Mgt_Types. creator) ; 

RETURN parent_process; 

end Get_parent_process; 

function This_job 

return Job_Ty pe s . j ob_AD 

Logic: 

1. Get the process globals 
entry for the current job. 

2. Return the current job. 
is' 

current_job: Job_Types. job_AD; 

current_job_untyped: System. untyped_word; 
FOR current_job_untyped USE AT 
current_job' address; 
begin 

current_job_untyped := Process_Mgt. 
Get_process_globals_entry ( 
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Process_Mgt_Types. job) 



RETURN current_job; 
end This_job; 

function This_session 

return Session_Types. session_AD 

Logic: 

1. Get process globals entry 
for the current session. 

2. Return the current session. 
is 

current_session: Session_Types. session_AD; 

current_session_untyped: System. untyped_word; 
FOR current_session_untyped USE AT 
current_session' address; 
begin 

current_session_untyped := Process_Mgt. 
Get_process_globals_entry ( 

Process_Mgt_Types= session) ; 

RETURN current_session; 

end This session; 



function Get_process_name 
return System_Defs.text_AD 

Logic: 

1. Return the name of the current process, 
is 

name: System_Defs.text_AD; 

name_untyped: System. untyped_word; 
FOR name_untyped USE AT name' address; 
begin 

name_untyped := Process_Mgt. 
Get_process_globals_entry ( 

Process Mgt Types. name); 
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614 RETURN name; 

615 

616 end Get_process_name; 

617 

618 

619 

620 procedure Set_process_name ( 

621 name: System_Defs.text) 
622 

623 — Logic: 

624 — 1. Check that "name" is a valid text. 

625 — 2. Set the new process name. 

626 is 

627 name_untyped: System. untyped_word; 

628 FOR name_untyped USE AT 

629 name' address; 

630 begin 

631 if name. length > name.max_length then 

632 RAISE System_Exceptions.bad_parameter; 
633 

634 else 

635 Process_Mgt . Set_process_globals_entry ( 

636 slot => Process_Mgt_Types.name, 

637 value => name_untyped) ; 

638 end if; 
639 

640 end Set_process_name; 

641 

642 

643 end Process_Globals_Support_Ex; 



X-A-190 Ada Examples 



rKH,ULMlINAKY 



X-A.6.10 Symbol Table Ex Package Specification 



1 package Symbol_Table_Ex is 
2 

3 — Function: 

4 — Manages a symbol table for use by a compiler or 

5 — other application. 
6 

7 — Synchronizes concurrent access to the symbol 

8 — table. 
9 

10 — Symbol names can be no longer than 

11 — "max_symbol_length" characters. 
12 

13 — There is no limit on the number of symbols in 

14 — the table; it is expanded as needed. 
15 

16 — The symbol table is created empty at package 

17 — initialization. 
18 

19 — Notes: 

20 — Nested blocks and symbols local to blocks are 

21 — not supported. 
22 

23 — Exceptions: 
24 

25 symbol_exists: exception; 

26 — "Add_symbol" was called with a symbol that is 

27 — already in the table. 
28 

29 no_such_symbol : exception; 

30 — "Read_symbol_data" was called with a symbol 

31 — that is not in the table. 
32 

33 name_too_long: exception; 

34 — "Add_symbol" or "Read_symbol_data" was called 

35 — with a symbol name longer than 

36 — "max_symbol_length". 
37 

38 max_symbol_length: constant positive := 32; 

39 — Maximum symbol length allowed. 
40 

41 — History: 

42 — 11-24-87, Paul Schwabe: updated spec. 
43 

44 — End of Header 

45 pragma external; 
46 

47 type symbol_data is record 

48 — This type defines the characteristics recorded 

49 — for each symbol in the table. No fields are 

50 — defined for this example package. 

51 null; 

52 end record; 
53 

54 

55 procedure Add_symbol ( 

56 name: string; 

57 — Name cannot be in use in the table. Name 

58 — cannot be longer than "max_symbol_length" . 

59 data: symbol_data) ; 
60 

61 — Function: 

62 — Adds a symbol and its data to the symbol 

63 — table. 
64 

65 — Exceptions: 

66 — symbol_exists 

67 — name_too_long 
68 

69 

70 function Read_symbol_data ( 

71 name: string) 

72 — Must name a symbol in the table. Name 

73 — cannot be longer than "max_symbol_length". 

74 return symbol_data; 
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75 

76 — Function: 

77 — Reads a symbol's data from the symbol table. 
78 

79 — Exceptions: 

80 — no_such_symbol 

81 — name_too_long 
82 

83 

84 end Symbol_Table_Ex; 
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X-A.6.1 1 Symbol_Table_Ex Package Body 



1 with Object_Mgt, 

2 Semaphore_Mgt, 

3 System; 
4 

5 package body Symbol_Table_Ex is 
6 

7 — Logic: 

8 — The symbol table is implemented as an object 

9 — containing an array. Because the table is 

10 — dynamically allocated, it can be expanded as 

11 — needed. 
12 

13 — The "symbol_table.lock" semaphore is used to 

14 — exclude other processes while a process is 

15 — accessing the table. All symbol table 

16 — operations lock ("P") the semaphore before 

17 — accessing the table, and unlock ("V") the 

18 — semaphore before returning or propagating an 

19 — exception. 
20 

21 ~ Notes: 

22 — A realistic implementation could be optimized 

23 — for keyed retrieval using a hash table. Such 

24 — an implementation could use the same locking 

25 — code. 

26 — History: 

27 — 11-24-87, Paul Schwabe: updated code. 

28 — 11-25-87, Gary Taylor : Added tagged comment lines. 
29 

30 — End of Header 

31 

32 use System; — Import arithmetic on type "ordinal". 

33 

34 table_size: constant System. ordinal := 100; 

35 

36 type symbol_name is array ( 

37 1 . . max_symbol_length) of character; 
38 

39 type symbol_entry is record 

40 name: symbol_name; 

41 data: symbol_data; 

42 end record; 
43 

44 FOR symbol_entry USE 

45 record at mod 32; 

46 end record; 
47 

48 type symbol_entry_array is array ( 

49 System. ordinal range <>) of symbol_entry; 
50 

51 type symbol_table_ob ject ( 

52 max_length: System. ordinal) is record 

53 — "max_length" is maximum number of entries in a 

54 — full table. Table can still grow by calling 

55 — "Expand_symbol_table" . 

56 length: System. ordinal; 

57 — Number of entries in use. 

58 lock: Semaphore_Mgt . semaphore_AD; 

5 9 — Used to lock symbol table while a process 

60 — is accessing it. 

61 value: symbol_entry_array (1 .. max_length) ; 

62 — Entries 1 . . "length" contain symbol 

63 — entries. 

64 end record; 
65 

66 type symbol_table_AD is access symbol_table_ob ject; 

67 pragma access_kind (symbol_table_AD, AD); 
68 

69 symbol_table: symbol_table_AD; 

70 procedure Expand_symbol_table is 
71 

72 — Operation: 

73 — Doubles the symbol table size. 
74 
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75 — "Expand_symbol_table" is normally called only 

76 — when the symbol table is full. 
77 

78 — Performs these steps: 

79 — 1. Resizes the symbol table object with space 

80 — for twice as many entries. 

81 — 2. Changes the maximum length of the 

82 — symbol table entry. 
83 

84 — Notes: 

85 — "Expand_symbol_table" is an internal 

86 — procedure that must be called with the symbol 

87 — table already locked via the associated 

88 — semaphore! 
89 

90 symbol_table_untyped: System. untyped_word; 

91 FOR symbol_table_untyped USE AT 

92 symbol_table' address; 
93 

94 max_length_access: System. ordinal; 

95 FOR max_length_access USE AT 

96 symbol_table.max_length' address; 

97 begin 

98 Object_Mgt. Resize ( 

99 obj => symbol_table_untyped, 

100 size => 3 + (2 * symbol_table.max_length * ( 

101 symbol_entry' size/32) ) ) ; 
102 

103 max_length_access := 2 * symbol_table.max_length; 

104 

105 

106 end Expand_symbol_table; 

107 

108 

109 procedure Add_symbol ( 

110 name: string; 

111 data: symbol_data) 
112 

113 — Logic: 

114 — 1. Surround everything else with a lock on 

115 — "symbol_table.lock" . Release the lock 

116 — on all return paths and exception paths. 

117 — 2. Check for "name" too long. 

118 — 3. Convert "name" to "fixed_width_name", 

119 — padding with blanks. 

120 — 4. Search the table and raise an exception if 

121 — the symbol is in the table. 

122 — 5. Otherwise, add the symbol to the end of 

123 — the table, expanding the symbol table if 

124 — it is full. 

125 is 

126 f ixed_width_name : symbol_name := (others => ' '); 

127 begin 

128 Semaphore_Mgt .P (symbol_table. lock) ; 

129 begin 

130 if name' length > max_symbol_length then 

131 RAISE name_too_long; 
132 

133 else 

134 fixed_width_name (1 .. name' length) : = 

135 symbol_name (name) ; 

136 for i in 1 .. symbol_t able. length loop 

137 if symbol_table. value (i) .name = 

138 fixed_width_name then 

139 RAISE symbol_exists; 

140 end if; 

141 end loop; 

142 if symbol_table. length = 

143 symbol_table.max_length then 

144 Expand_symbol_table; 

145 end if; 

146 symbol_table. length := symbol_table. length + 1; 

147 symbol_table. value (symbol_table. length) := 

148 symbol_entry' (fixed_width_name, data); 

149 end if; 
150 

151 exception 
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when others => 

Semaphore_Mgt .V (symbol_table. lock) ; 
RAISE; 

— Reraise exception that entered handler, 
end; 

Semaphore_Mgt.V(symbol_table.lock) ; 



end Add_symbol; 



function Read_symbol_data ( 
name: string) 
return symbol_data 

— Logic: 

1. Surround everything else with a lock on 
"symbol_table.lock". Release the lock 
on all return paths and exception paths. 

2. Check for "name" too long. 

3. Convert "name" to "fixed_width_name" , 
padding with blanks. 

— 4. Search the table. If the symbol is found, 
return the symbol data. Otherwise raise 

— "no such symbol". 



f ixed_width_name : 
begin 



symbol name := (others => ' ' ) 



Semaphore_Mgt.P (symbol_table. lock) ; 

if name' length > max_symbol_length then 
RAISE name_too_long; 

else 

fixed_width_name (1 .. name' length) := 

symbol_name (name) ; 
for i in 1 .. symbol_t able. length loop 
if symbol_table. value (i) .name = 
fixed_width_name then 
Semaphore_Mgt.V(symbol_table.lock) ; 
RETURN symbol_table. value (i) .data; 

end if; 
end loop; 

RAISE no_such_symbol; 

end if; 

— This call to "V" is never reached in the 

— current implementation. The call is included 

— as a safeguard in case code changes make it 

— reachable. 

Semaphore_Mgt .V (symbol_table.lock) ; 

exception 

when others => 

Semaphore_Mgt.V(symbol_table.lock) ; 
RAISE; — Reraise exception 

— that entered handler. 

end Read symbol data; 



— PACKAGE INITIALIZATION 
begin 

symbol_table := new symbol_table_object ( 
table_size) ; 

symbol_table. length := 0; 

— Symbol table initially has space for 100 

— entries with in use. 
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229 symbol_t able. lock := Semaphore_Mgt . 

230 Create_semaphore; 

231 — Lock initially indicates table is available. 

232 — First "P" on lock will succeed. 
233 

234 end Symbol_Table_Ex; 
235 
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X-A.6.12 wordj?rocessor_Ex Package Specification 



1 package Word_Processor_Ex is 
2 

3 — Function: 

4 — This example shows how a word processor with a 

5 — spelling checker can use processes and events. 
6 

7 — End of Header 

8 pragma external; 
9 

10 

11 procedure Word_processor; 

12 

13 — Function: 

14 — Does word processing. 
15 

16 — Gets its arguments from the command line. 

17 

18 — Includes a concurrent spelling checker. 

19 

20 

21 end Word Processor Ex; 
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X-A.6.13 word_Processor_Ex Package Body 



1 with Conversion_Support_Ex, 

2 Event_Mgt ff 

3 Process_Globals_Support_Ex, 

4 P r oce s s_Mgt , 

5 Process_Mgt_Types, 

6 System; 
7 

8 package body Word_Processor_Ex .is 
9 

10 — Logic: 

11 — This example shows how a word processor with a 

12 — concurrent spelling checker uses processes 

13 — and events. 
14 

15 — The "Word_jprocessor" procedure spawns a 

16 — separate process to execute the 

17 — "Spelling_checker" procedure. Communication 

18 — between the two processes is entirely via 

19 == events. 
20 

21 — When a word is entered by the word processor 

22 — user, the word processor signals a 'word' event 

23 — to the spelling checker process. That event 

24 — has these 

25 — fields: 
26 

27 — "event" - "word_event_value" . 
28 

29 — "message. offset" - Location of word to check, 

30 — encoded as a 32-bit 

31 — "word_record" . 
32 

33 — "message. AD" - AD to word processor 

34 — process that is signalling 

35 — the event. 
36 

37 — "destination" - AD to spelling checker 

38 — process that receives 

39 — the event. 
40 

41 — Inclusion of an AD to the process that signals 

42 — the event allows a future implementation to use 

43 — the spelling checker process as a server for 

44 — multiple client processes. 
45 

46 — If a word is misspelled, the spelling checker 

47 — signals a 'spelling error' event to the process 

48 — that requested the spelling check. 
4 9 — That event has these fields: 

50 

51 — "event" - spelling_error_event_value. 

52 

53 — "message. of f set" - Location of word that was 

54 — checked, encoded as a 32-bit 

55 — "word_record". 
56 

57 — "message. AD" - Not used. In this 

58 — implementation, 

59 — is "System. null_word". 
60 

61 — "destination" - AD to the word processor 

62 — process that signalled the word to the spelling 

63 — checker. 
64 

65 — The word processor handles spelling error 

66 — events with the "Spelling_error_handler" 

67 — procedure. 
68 

69 — Notes: 

70 — The "word_record" scheme of communicating words 

71 — to be checked is probably inadequate for an 

72 — implementation of the spelling checker as a 

73 — general server that can be used by multiple 

74 — concurrent applications. 
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— History: 

11-24-87, Paul Schwabe: 
11-25-87, Gary Taylor : 

— End of Header 



updated code. 
Added tagged comment lines. 



use System; — Import operations on ordinal types. 

type word_record is record 

— This type encodes a word location into 32 bits, 

— allowing a word location to be transmitted 

— using the "message. offset" field when an event 

— is signalled. The word processor and spelling 

— checker are presumed to share a two-dimensional 

— array containing the text being edited. Words 

— are presumed to not break across lines of the 

— array. A word location can thus be specified 

— as a line number, a starting column number, and 

— an ending column number. The encoding limits 

— line numbers to the range . . 65_535 and 



— column numbers to the range 
line: System. short_ordinal; 
start_col: System. byte_ordinal; 
end_col: System. by te_ordinal; 
end record; 



255, 



FOR word_record USE 

record at mod 32; 

line at range 
start_col at range 16 
end_col at range 24 

end record; 



— « Event Values Used >> 



15; 
23; 

31; 



— The following local events can use the same event 

— value without conflict because they are always 

— signalled to different processes. 

word_event_value : 

constant Event_Mgt.event_value := Event_Mgt .user_l; 

— Local event signalled to spelling checker for 

— each word to be checked. 

spelling_error_event_value : 

constant Event_Mgt .event_value := 
Event_Mgt . user_l ; 

— Local event signalled to client process for 

— each misspelled word. 



procedure Spelling_checker ( 

param_buffer: System. address; 

— Not used but required for process's initial 

— procedure. 
param_length: System. ordinal) 

— Not used but required for process's initial 

— procedure. 

— Operation: 

— Loops doing these steps: 

1. Wait for a word event. 

2. Check the word's spelling. 

3. If the word is misspelled, signal a 
spelling error event to whatever 

— process requested the check, 
is 

word_event : Event_Mgt . action_record; 

— Receives each word to be checked. 
current_word: word_record; 

FOR current_word USE AT word_event. 
message. offset' address; 

— Overlay used to extract word location., 
word_mi spelled: boolean; 

begin 
loop 
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152 Event_Mgt.Wait_for_any { 

153 events => (word_event_value => true, 

154 others => false) , 

155 action => word_event); 
156 

157 — Code" to check spelling of current word goes 

158 — here. The "word_mi spelled" flag is a stand-in 

159 — for whatever conditional expression indicates 

160 — a mispelled word. 
161 

162 if word_mi spelled then 

163 Event_Mgt .Signal (Event_Mgt.action_record' ( 

164 event => spelling_error_event_value, 

165 message => ( 

166 offset => word_event. message. of f set, 

167 AD ~> System. null_word) , 

168 destination => word_event. message. AD) ) ; 

169 end if; 
170 

171 end loop; 
172 

173 end Spelling_checker; 

174 pragma subprogram_value (Process_Mgt . Initial_proc, 

175 Spelling_checker) ; 
176 

177 

178 . procedure Spelling_error_handler ( 

179 action: Event_Mgt.action_record) 
180 

181 — Operation: 

182 — Handler invoked for each ' spelling error' 

183 — event. 

184 is 

185 misspelled_word: word_record; 

186 FOR misspelled_word 

187 USE AT action. message. offset' address; 

188 — Overlay used to extract word location. 

189 begin 

190 — Code to handle misspelled word goes here. For 

191 — example, this code could highlight the 

192 — misspelled word on the display and ring the 

193 — terminal's bell. 
194 

195 null; 

196 end Spelling_error_handler; 

197 pragma subprogram_value { 

198 Event_Mgt.Event_handler, 

199 Spelling_error_handler) ; 
200 

201 

202 procedure Word_processor 

203 

204 — Logic: 

205 — 1. Retrieve an AD for this process, to be 

206 — passed to the spelling checker so it will 

207 — know what process to signal if a word is 

208 — misspelled. 
209 

210 — 2. Create the spelling checker process. 
211 

212 — 3. Establish a handler for the spelling error 

213 — local event and enable the event. Save the 

214 — previous event status. 
215 

216 — 4. Loop, doing word processing. For each 

217 — word that is entered, signal the word event 

218 — to the spelling checker process. 
219 

220 — 5. When word processing is done, terminate and 

221 — deallocate the spelling checker process and 

222 — restore the previous event status for the 

223 — spelling error local event. 

224 is 

225 spelling_ehecker_process: 

226 Process_Mgt_Types.process_AD; 

227 — Process executing "Spelling_checker". 
228 
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child_termination_event_value : 

constant Event_Mgt . event_value := 
Event_Mgt .user_2; 

— Local event signalled when spelling checker 

— process terminates. 

child_termination_event : Event_Mgt .action_record; 

— Action record used to receive spelling checker 

— process's termination event. 

this_process_untyped: System. untyped_word; 

— Process executing "Word_processor", 

— as an "untyped_word" . 

word_event : Event_Mgt . action_record; 

— Used to signal each word to be checked. 
current_word: word_record; 

FOR current_word 

USE AT word_event. message. off set' address; 

— Overlay used for word location. 

old_event_status : Event_Mgt . event_status; 

— Saves previous event status for the 

— spelling_error local event, so the previous 

— status can be restored before exit. 

begin 

this_process_untyped := 

Process_Mgt .Get_process_globals_entry ( 
Process_Mgt_Types. process) ; 

spelling_checker_process := Process_Mgt. 
Spawn_process ( 
init_proc => 

Spelling_checker' subprogram_value, 
term_action => ( 
event => 

child_termination_event_value, 
message => System. null_address, 

— Not used, 
destination => this_process_untyped) ) ; 

old_event_status := Event_Mgt . 
Establish_event_handler ( 

event => spell ing_error_event_value, 
status => ( 

handler => 

Spelling_error_handler' 

subprogram_value , 
state => Event_Mgt .enabled, 
interrupt_system_call => false) ) ; 

loop 

— Presume that control exits the loop when a 

— user quits the word processor. 



— Code to do word processing goes here. 

— each word entered by the user, 

— the following code is executed: 



For 



word_event. event := word_event_value; 
word_event. message. AD := this_process_untyped; 

— Code goes here to assign "current_word" which 

— overlays "word_event. message. off set". 

word_event .destination := 

Conversion_Support_Ex.Untyped_from_process ( 
spelling_checker_process) ; 
Event_Mgt . Signal ( word_event ) ; 

end loop; 

<< QUIT >> — Presume control reaches this point 

— when a user exits the word 

— processor. 
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306 Event_Mgt .Signal (Event_Mgt.action_record' ( 

307 event => Event_Mgt .termination, 

308 message => System. null_address, 

309 — No message. 

310 destination => Conversion_Support_Ex. 

311 Untyped_from_process ( 

312 spelling_checker_process) ) ) ; 

313 Event_Mgt .Wait_f or_any ( 

314 events => ( 

315 child_termination_event_value => true, 

316 others => false) , 

317 action => child_termination_event) ; 

318 Process_Mgt. Deallocate (spelling_checker_process) 
319 

320 old_event_status := Event_Mgt. 

321 Establish_event_handler ( 

322 event => spelling_error_event_value, 

323 status => old_event_status) ; 

324 — Reestablish previous event status. 

325 — Value returned is never used. 
326 

327 end Word_processor; 

328 

329 

330 end Word Processor Ex; 
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X-A.6.14view device main Procedure 



1 with CL_Defs, 

2 Command_Handler, 

3 Device_Defs, 

4 Environment_Mgt, 

5 System, 

6 System_Defs, 

7 VD_Commands , 

8 VD_Devices, 

9 VD_Defs; 
10 

11 procedure View_device_main 
12 

13 — Function: 

14 — Main program for "view. device" utility 

15 — (Command-Oriented Program Example) . 
16 

17 — The procedure "View_device_main" is 

18 — called from CLEX. "View_device_main" 

19 — performs the top-level processing for the 

20 — "view. device" example utility. 
21 

22 — History: 

23 — 10-08-87, William A. Rohm: Written. 

24 — 11-17-87, WAR: Revised. 
25 

26 is 

27 

28 — Variables: 

29 

30 command: System. short_ordinal; 

31 — Index of current command (in current 

32 — command set) . 
33 

34 command_name : System_Defs. text (CL_Def s.max_name_sz) ; 

35 — Name of current command (in current 

36 — command set) . 
37 

38 current_cmd_odo : Device_Defs.opened_device := 

3 9 Command_Handler . Open_invocation_command_processing; 

40 — Current opened command input device, 

41 — initially the invocation command. 
42 

43 device_name: System_Def s. text (256) ; 

44 — Pathname of viewed device. 
45 

4 6 device_opened: boolean; 

47 — Returned true from 

48 — "VD_Devices.Open_device" if device 

49 — successfully opened. 
50 

51 processing_runtime: boolean := false; 

52 — True if currently processing runtime 

53 — commands, false if processing startup 

54 — commands. 
55 

56 use System; — to import = for 

57 — System. short_ordinal 
58 

59 begin 

60 

61 VD_Devices.Open_program_window; 

62 

63 — Get ": device" pathname: 

64 

65 Command_Handler.Get_string( 

66 cmd_odo => current_cmd_odo, 

67 arg_number => 1, 

68 arg_value => device_name) ; 
69 

70 — Close invocation command processing: 

71 

72 Command_Handler. Close (current_cmd_odo) ; 

73 

74 
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75 — Open startup command input: 
76 

77 current_cmd_odo := 

78 Command_Handler .Open_startup_command_processing ( 

79 cmd_set => VD_Def s.main_cmd_set) ; 
80 

81 

82 — Main processing loop: 

83 

84 loop 

85 

86 Command_Handler.Get_command( 

87 cmd_odo => current_cmd_odo, 

88 prompt => VD_Defs.main_prompt, 

89 cmd_id => command, 

90 cmd_name => command_name) ; 
91 

92 case command is 

93 when VD_Defs.main_change_ID => 

94 Command_Handler . Get_string ( 

95 emd_odo => current_cmd_odo, 

96 arg_number => 1, 

97 arg_value => device_name) ; 
98 

99 VD_Devices.device_info_valid := false; 

100 

101 when VD_Defs.main_list_ID => 
102 

103 declare 

104 ops: boolean; 

105 — Returned ": operations" parameter. 
106 

107 begin 

108 — Get ": operations" parameter: 
109 

110 ops := Command_Handler.Get_boolean ( 

111 cmd_odo => current_cmd_odo, 

112 arg_number => 1) ; 
113 

114 

115 — Display device information: 

116 

117 VD_Commands.Display_device_info { 

118 device__name => device_name, 

119 operations => ops); 
120 

121 end; 

122 

123 

124 when VD_Defs.main_access_ID => 

125 

126 declare 

127 open_mode: System. short_ordinal; 

128 — Enumeration index value of "access. device" method. 
129 

130 begin 

131 — Get desired open mode: 
132 

133 open_mode := 

134 Command_Handler.Get_enumeration_index ( 

135 cmd_odo => current_cmd_odo, 

136 arg_number => 1); 
137 

138 — Open device: 

139 

140 device_opened := VD_Devices.Open_device ( 

141 device_name => device_name, 

142 open_mode => Device_Defs. 

143 open_mode' val (open_mode) ) ; 

144 end; 
145 

146 if device_opened then 

147 — Change to "access" command set: 
148 

149 Command_Handler . Change_cmd_set ( 

150 cmd_odo => current_cmd_odo, 

151 cmd set name => VD Defs. access cmd set); 
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152 

153 VD_Commands.Process_access_commands ( 

154 cmd_odo => current_cmd_odo) ; 
155 

156 — Return to "main" command set: 

157 

158 Command_Handler . Change_cmd_set ( 

159 cmd_odo => current_cmd_odo, 

160 cmd_set_name => VD_Defs.main_cmd_set) ; 
161 

162 end if; — if device_opened 

163 

164 when VD_Defs.main_exit_ID => 

165 

166 if processing_runtime then 

167 EXIT; 

168 else 
169 

170 — Close invocation command input 

171 — device: 
172 

173 Command_Handler .Close (current_cmd_odo) ; 

174 

175 — Open runtime command processing: 

176 

177 current_cmd_odo := 

178 Command_Handler.Open_runtime_command_processing ( 

179 cmd_set => VD_Def s.main_cmd_set) ; 
180 

181 processing_runtime := true; 

182 

183 end if; 

184 

185 when others => 

186 null; 
187 

188 end case; 

189 

190 end loop; 

191 

192 if device_opened then 

193 VD_Devices.Close_device; 

194 end if; 
195 

196 — Close runtime command input device: 

197 

198 Command_Handler. Close <current_cmd_odo) ; 

199 

200 — Close program window: 

201 

202 VD_Devices.Close_program_window; 

203 

204 end View device main; 
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X-A.6.15VD Defs Package Specification 



1 with System, 

2 SystemJDefs, 

3 Terminal_Defs; 
4 

5 package VD_Defs is 
6 

7 — Function: 

8 — Contains definitions for the constants in 

9 — the Example Utility. 
10 

11 — History: 

12 -- 10-08-87, William A. Rohm: Written. 

13 — 11-16-87, WAR: Revised. 
14 

15 — End of Header 

16 

17 

18 — Constants: 

19 

20 program_window_size: 

21 Terminal_Defs.point_info := (80,20); 

22 — Size of program's window, in columns 

23 — and rows. 
24 

25 program_buffer_size: 

26 Terminal_Defs.point_info := (80,20); 

27 — Size of program window's buffer. 
28 

29 program_window_pos: 

30 Terminal_Defs.point_info := (1,1); 

31 — Position of program' s window on 

32 — terminal (upper left corner) . 
33 

34 main_cmd_set_str: constant string := "$OEO/main"; 

35 — String value of main command set's 

36 — pathname. 
37 

38 main_cmd_set : System_Defs.text ( 

39 main_cmd_set_str' length) := ( 

40 main_cmd_set_str' length, 

41 main_cmd_set_str' length, 

42 main_cmd_set_str) ; 

43 — Pathname of main command set. 

44 • 
45 

4 6 access_cmd_set_str: constant string := "$OEO/access' 

47 — String value of "device access" command 

48 — set's pathname. 
49 

50 access_cmd_set: System_Def s. text ( 

51 access_cmd_set_str' length) := ( 

52 access_cmd_set_str' length, 

53 access_cmd_set_str' length, 

54 access_cmd_set_str) ; 

55 — Pathname of "device access" command set. 
56 

57 

58 main_prompt_str: constant string := "view.device> "; 

5 9 — String value of prompt for "main" command 
60 — set. 

61 

62 main_prompt: System_Def s. text ( 

63 main_prompt_str' length) := ( 

64 main_prompt_str' length, 

65 main_prompt_str' length, 

66 main_prompt_str) ; 

67 — "main" prompt's text. 
68 

69 

70 access_prompt_str: constant string := 

71 "access. device> "; 

72 — String value of prompt for "access™ 

73 — command set. 
74 
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access_prompt : System_Def s . text ( 
access_prompt_str' length) := ( 
access_prompt_str' length, 
access_prompt_str' length, 
access_prompt_str) ; 
— "access" prompt's text. 



— Command and Argument Indexes: 



main_change_ID : 
main_list_ID: 
ma i n_a cce s s_I D : 
main exit ID: 



constant System. short_ordinal 
constant System. short_ordinal 
constant System. short_ordinal 
constant System. short_ordinal 



:= 1; 
:= 2; 
:= 3; 
:= 4; 



— *Main* command set command index values. 

input_index: constant 

System. short_ordinal := 1; 
output_index : constant 

System. short_ordinal := 2; 
input_partial_index: constant 

System. short_ordinal := 3; 
input_output_index: constant 

System. short_ordinal := 4; 

— For "access. device :open_mode"; the 

— argument's enumeration index values. 



access_read_ID: constant System. short_ordinal 
access_write_ID: constant System. short_ordinal 
access_exit_ID: constant System. short_ordinal 

— *access* command set's 

— command index values. 

read_length_arg: constant 

System. short_ordinal := 1; 
read_position_arg: constant 

System. short_ordinal := 2; 
read_offset_arg: constant 

System. short_ordinal := 3; 

— Argument index values for "read" . 

write_position_arg: constant 

System. short_ordinal := 1; 
write_offset_arg: constant 

System. short_ordinal := 2; 

— Argument index values for "write", 

end VD Defs; 



:= 1; 
:= 2; 
:= 3; 
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X-A.6.16 VD_Commands Package Specification 



1 with Device_Defs, 

2 System^Defs; 
3 

4 package VD_Commands is 
5 

6 — Function: 

7 — Contains operations related to processing 

8 — "view. device" "access" command set's 

9 — commands . 
10 

11 — History: 

12 — 10-08-87, William A. Rohm: Written. 

13 ~ 11-17-87, WAR: Revised. 
14 

15 — End of Header 

16 

17 

18 procedure Display_device_info ( 

19 device_name: System_Def s. text; 

20 — Pathname of device. 

21 operations: boolean); 

22 — If true, displays "Byte_Stream_AM.Ops" 

23 — operations supported by "device_name" . 
24 

25 — Function: 

26 — Calls "VD_Devices.Get_device_info", 

27 — then displays the returned device 

28 — information record. 
29 

30 

31 procedure Process_access_commands ( 

32 cmd_odo: Device_Defs.opened_device) ; 

33 — Opened command input device. 
34 

35 — Function: 

3 6 — Processes the "access" command set. 

37 

38 

3 9 end VD Commands; 
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X-A.6.17VD_Commands Package Body 



1 with Byte_Stream_AM, 

2 CL_Defs, 

3 Command_Handler, 

4 Device_Defs, 

5 System, 

6 System_Def s, 

7 Text_Mgt , 

8 VD_Defs, 

9 VD_De vices ; 
10 

11 package body VD_Commands is 
12 

13 — Function: 

14 — Contains operations related to processing 

15 — "view. device" "access" command set. 
16 

17 — History: 

18 — 10-08-87, William A. Rohm: Written. 

19 — 11-17-87, WAR: Revised. 
20 

21 — End of Header 

22 

23 

24 procedure Display_device_info ( 

25 device_name: System_Defs.text; 

26 operations: boolean) 
27 

28 — Logic: 

29 — 1. Check for valid device info record; get it 

30 — if not valid 

31 — 2. Display common device info values 

32 — 3. Display BSAM device info values 

33 — 4. If "operations" is true, display supported 

34 — ops 
35 

36 is 
37 

38 procedure Write_inf o ( 

39 info_string: string) 

40 — String value to be written. 

41 is 
42 

43 — Function: 

44 — Display string value, followed by a linefeed. 
45 

46 info_text: System_Def s.text (32) ; 

47 — Text value of various values' "'image"s. 

48 begin 
49 

50 — Make a text value of "info_string" : 
51 

52 Text_Mgt . Set ( 

53 dest => info_text, 

54 source => info_string) ; 
55 

56 — Add a linefeed: 

57 

5 8 Text_Mgt . Append ( 

59 dest => info_text, 

60 source => Standard. ASCII. LF) ; 
61 

62 — Write text to the program's window: 
63 

64 Byte_Stream_AM. Ops. Write ( 

65 opened_dev => VD_Devices.program_window, 

66 buffer_VA => info_text' address, 

67 length => System. ordinal (info_text .length) ) 
68 

69 end Write_info; 

70 

71 

72 begin 

73 

74 — Check for valid "device info": 
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75 

76 if not VD_Devices.device_info_valid then 

77 VD_Devices.Get_device_info ( 

78 device_name => device_name) ; 

79 end if; 
80 

81 

82 — Display node id: 

83 

84 Write_info( 

85 info_string => " Node ID:"); 
86 

87 Write_info( 

88 info_string => System_Defs.node_ID' image ( 

89 VD_Devices.device_info.common_info.node) ) ; 
90 

91 

92 — Display access methods supported: 

93 

94 Write_inf o ( 

95 info_string -> " Access Methods Supported:"); 
96 

97 for i in Device_Defs.access_method' first .. 

98 Device_Defs.access_method' last loop 
99 

100 if VD_Devices.device_info. 

101 common_info.acc_methods_supp (i) then 
102 

103 Write_info( 

104 info_string => Device_Defs. 

105 access_method' image (i) ) ; 

106 end if; 
107 

108 end loop; 

109 

110 

111 — Display open modes supported: 

112 

113 Write_inf o ( 

114 info_string => " Supported Open Modes:"); 
115 

116 for i in Device_Defs.open_mode' first .. 

117 Device_Defs.open_mode' last loop 
118 

119 if VD_Devices.device_info. 

120 common_info.open_modes_supp (i) then 
121 

122 Write_info( 

123 info_string => Device_Defs. 

124 open_mode ' image ( i ) ) ; 

125 end if; 
126 

127 end loop; 

128 

129 

130 — Display "store supported" boolean: 

131 

132 Write_info( 

133 info_string => " Data written to device can be read back:") 
134 

135 Write_inf o ( 

136 info_string => boolean' image ( 

137 VD_Devices.device_info. 

138 common_info.store_supp) ) ; 
139 

140 

141 — Display "is interactive" boolean: 

142 

143 Write_info( 

144 info_string => " Device is interactive is:"); 
145 

146 Write_info( 

147 info_string ==> boolean' image ( 

148 VD_Devices.device_info. 

149 common_info.is_interactive) ) ; 
150 

151 
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— Display byte-stream operations supported; 

if operations then 
Write_inf o ( 

info_string =•> " Supported Byte Stream Operations:") 

for i in Byte_Stream_AM.bsam_operation' first .. 
Byte_Stream_AM.bsam_operation' last loop 

if VD_Devices.device_info.bsam_ops_supp (i) then 

Write_inf o ( 

info_string => Byte_Stream_AM. 
bsam_operation' image (i) ) ; 
end if; 

end loop; 

end if; 

end Di splay _device_info ; 



procedure Process_access_commands ( 

cmd_odo: Device_Defs.opened_device) 



command: System. short_ordinal; 

— Index of current command (in current 

— command set) . 

command_name : System_Defs. text (CL_Def s.max_name_sz) ; 

— Name of current command (in current 

— command set) . 

length: CL_Def s.CL_range; 

— Length of displayed bytes for "read : length" . 

position: System. short_ordinal; 

— Index of "read/write :position" argument's value. 

offset: integer; 

— Value of "read/write : offset" argument. 

begin 

— Command processing loop: 

loop 

Command_Handler . Get_command ( 
cmd_odo => cmd_odo, 
prompt => VD_Defs.access_prompt, 
cmd_id => command, 
cmd name => command name) ; 



case command is 

when VD_Def s.access_read_ID => 

— Get ": length" argument: 

length := Command_Handler.Get_range ( 
cmd_odo -> cmd_odo, 
arg_number => VD_Defs.read_length_arg) ; 



~ Get 



: position" argument: 



position := Command_Handler. 
Get_enumeration_index ( 

cmd_odo => cmd_odo, 

arg_number => VD_Defs.read_position_arg) ; 

— Get ": offset" argument: 

offset := Command Handler. Get integer ( 
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229 cmd_odo => cmd_odo, 

230 arg_number => VD_Defs.read_off set_arg) ; 
231 

232 — Read and display bytes: 

233 

234 ~ TBD 

235 

236 when VD_Defs.access_write_ID => 

237 

238 — Get ": position" argument: 

239 

240 position := Command_Handler. 

241 Get_enumeration_index { 

242 cmd_odo => cmd_odo, 

243 N arg_number => VD_Defs.write_position_arg) 
244 

245 — Get ":offset" argument: 

246 

247 offset := Command_Handler.Get_integer ( 

248 cmd_odo => cmd_odo, 

249 arg_number => VD_Defs.write_of f set_arg) ; 
250 

251 — Get bytes and write to device: 

252 

253 — TBD 

254 

255 when VD_Defs.access_exit_ID => 

25 6 EXIT; 

257 

258 when others => 

259 null; 
260 

261 end case; 

262 

263 end loop; 

264 

265 end Process_access_commands; 

266 

267 end VD Commands; 
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X-A.6.18 vd Devices Package Specification 



1 with Byte_Stream_AM, 

2 Device_Defs, 

3 Long_Integer_Defs, 

4 System, 

5 System_Defs; 
6 

7 package VD_Devices is 

8 

9 — Function: 

10 — Contains all operations related to the 

11 — viewed device and the windows. 
12 

13 — This package contains calls to open and 

14 — close the program's windows, and calls to 

15 — read and write bytes to and from the 

16 — viewed device. 
17 

18 — History: 

19 — 10-08-87, William A. Rohm: Written. 

20 — 11-17-87, WAR: Revised. 
21 

22 — End of Header 

23 

24 

25 — Variables: 

26 

27 program_window: Device_Def s.opened_device; 

28 — Utility's window, for accepting commands 

29 — and displaying data. 
30 

31 

32 opened_device: Device_Defs.opened_device := 

33 System. null_word; 

34 — Opened viewed device. 
35 

36 device_info: Byte_Stream_AM.device_info; 

37 — Device information record for 

38 ~ "Byte_Stream_AM". 
39 

40 device_info_valid: boolean := false; 

41 — Whether the device information record is valid. 
42 

43 

44 procedure Open_program_window; 

45 

4 6 — Function: 

47 — Open the program's window on the 

48 — current terminal. 
49 

50 

51 procedure Close_program_window; 

52 

53 — Function: 

54 — Closes the program's main window, and 

55 — any opened "::window" windows. 
56 

57 

58 procedure Get_device_info { 

59 device_name: System_Def s. text) ; 
60 

61 — Function: 

62 — Calls "Byte_Stream_AM.Get_device_info" to set 

63 — "VD_Devices.device_info" information record. 
64 

65 

66 function Open_device( 

67 device_name: System_Defs.text; 

68 — Pathname of device to be opened. 

69 open_mode: Device_Defs.open_mode) 

70 — Open mode for device. 

71 return boolean; 

72 — True if device successfully opened. 
73 

74 — Function: 
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75 — Opens given device with 

76 — "Byte_Stream_AM.Open_by_name", 

77 — returning true if successful. 
78 

79 •=>= Sets this package's "opened_device" 

80 — variable; "System. null_word n if 

81 — inaccessible. 
82 

83 

84 procedure Read_bytes( 

85 length: System. ordinal; 

86 — Number of bytes to be read and 

87 — displayed. 

88 position: Byte_Stream_AM.position_mode; 

89 — Position from which "offset" is measured. 

90 offset: integer; 

91 — Offset of first byte to be read and 

92 — displayed. 

93 bytes: out System_Defs.text) ; 

94 — Bytes read from device. 
95 

96 — Function: 

97 — Reads and displays bytes from the opened 

98 — device. 
99 

100 

101 procedure Write_bytes ( 

102 position: Byte_Stream_AM.position_mode; 

103 — Position from which "offset" is measured. 

104 offset: System. ordinal; 

105 — Offset of first byte to be written to 

106 — device. 

107 bytes: System_Defs .text) ; 

108 — Bytes to be written to device. 
109 

110 — Function: 

111 — Reads and displays bytes from the opened 

112 — device. 
113 

114 

115 procedure Close_device; 

116 

117 — Function: 

118 — Closes opened device with 

119 — "By te_Stream_AM. Close". 
120 

121 end VD Devices; 
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X-A.6.19vD_Devices Package Body 



1 with Access_Mgt, 

2 Byte_Stream_AM, 

3 Device_Defs, 

4 Directory _Mgt, 

5 — Example_Messages, 

6 Object_Mgt, 

7 Process_Mgt, 

8 Process_Mgt_Types, 

9 System, 

10 System_Defs, 

11 System_Exceptions, 

12 Terminal_Defs, 

13 Unchecked_Conversion, 

14 VD_Defs, 

15 Window_Services; 
16 

17 

18 package body VD_Devices is 

19 

20 — History: 

21 — 10-08-87, William A. Rohm: Written. 

22 — 11-17-87, WAR: Revised. 
23 

24 — End of Header 

25 

26 

27 

28 procedure Open_program_window 

29 

30 — Logic: 

31 — 1. Gets device AD to underlying terminal. 

32 — 2. Opens and assigns "program_window" . 

33 is 

34 old_opened_window: Device_Defs. opened_device; 

35 old_window: Device_Defs. device; 

36 underlying_terminal : Device_Defs. device; 
37 

38 begin 
39 

40 — Assume standard input, on entry, is from 

41 — an opened window: 
42 

43 old_opened_window := 

44 Process_Mgt .Get_process_globals_entry ( 

45 Process_Mgt_Types. standard_input) ; 
46 

47 

48 — Get device object of standard input 

49 — window: 
50 

51 old_window := 

52 Byte_Stream_AM.Ops.Get_device_object ( 

53 old_opened_window) ; 
54 

55 

56 -- Get device AD of standard input window's 

57 — terminal: 
58 

59 underlying_terminal := 

60 Window_Services . Ops . Get_terminal { 

61 old_window) ; 
62 

63 

64 — Create program window: 

65 

66 program_window := Window_Services.Ops.Create_window ( 

67 terminal => underlying_terminal, 

68 pixel_units => false, — characters, not pixels 

69 fb_size => VD_Defs.program_buf fer_size, 

70 desired_window_size => VD_Defs.program_window_size, 

71 window_pos => VD_Defs.program_window_pos, 

72 view_pos => Terminal_Defs.point_info' (1, 1) ) ; 
73 

74 end Open_program_window; 
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procedure Close_program_window 



Logics 

1. Close the program window. 



is 
begin 



Window_Services . Ops . Destroy_window (program_window) 
end Close_program_window; 



procedure Get_device_inf o ( 

device name: System Defs.text) 



device: Device_Defs. device; 

— Device. 

device_untyped: System. untyped_word; 

FOR device_untyped USE AT device' address; 

— Device as an untyped word. 

begin 

begin 

device_untyped := Directory_Mgt. Retrieve ( 
name => device_name) ; 

device_info := 

Byte_Stream_AM . Ops . Get_device_inf o { 
dev => device) ; 

device_info_valid := true; 

exception 

when Directory _Mgt .no_access => 
RAISE; — msg no_access 

when others => RAISE; 

end; 

end Get device info; 



function Open_device ( 

device_name: System_Defs.text; 
open_mode: Device_Defs. open_mode) 
return boolean 

— Logic: 

1. Check for allowed open mode 

2. Attempt "BSAM_AM.Open_by_name" 

3. If successful, assign 
"opened_device", return true; 

— otherwise, assign "opened_device" 
null, return false 

is 

successful: boolean := false; 

— Returned true if successfully opens 

— device, 
begin 

if not device_info_valid then 
Get_device_info (device_name) ; 

end if; 

if device_info_valid and 

device_inf o . common_inf o . 

open_modes__supp(open_mode) then 

— Try to open device: 
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begin 

opened_device := Byte_Stream_AM.Open_by_name ( 
name => device_name, 
input_output => open_mode, 
allow => Device_Defs. anything, 
block => true) ; 

successful := true; 

exception 

when others => 

opened_device := System. null_word; 
end; 

end if; — if valid and open_mode 
— supported 

return successful; 

end Open_device; 



procedure Read_bytes ( 

length: System. ordinal; 

position: By te_St ream_AM. posit ion_mode; 

offset: integer; 

bytes: out System_Def s. text) 
is 

byte_position: Long_Integer_Def s.long_integer; 

— Byte pointer position, returned from 

— "Byte_Stream_AM.Ops.Set_position". 

bytes_read: System. ordinal; 

— Number of bytes actually read. 

use System; — to import "/=" for System. ordinal 

begin 

byte_position := Byte_Stream_AM.Ops.Set_position ( 
opened_dev => opened_device, 
pos => Long_Integer_Defs. 
Convert_to_long_integer { 
number => offset) , 
mode => position) ; 

bytes_read := Byte_Stream_AM. Ops. Read ( 
opened_dev => opened_device, 
buffer_VA => bytes' address, 
length -> System. ordinal (offset) , 
block => false); 

if integer (bytes_read) = offset then 

bytes_read := Byte_Stream_AM.Ops.Read ( 
opened_dev => opened_device, 
buffer_VA => bytes' address, 
length => bytes' size/8, 
block => false) ; 

if bytes_read /= length then 

bytes. length := System_Defs.text_length (bytes_read) 

end if; 

end if; 
end Read bytes; 



procedure Write_bytes ( 

position: By te_Stream_AM. posit ion_mode; 
offset: System. ordinal; 
bytes: System Defs.text) 



bytes_read: System. ordinal; 

— Number of bytes actually read. 
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229 

230 use System; — import "=" for System. ordinal; 

231 

232 begin 

233 

234 bytes_read := Byte_Stream_AM.Ops.Read( 

235 opened_dev => opened_device, 

236 buffer_VA => bytes' address, 

237 length => offset, 

238 block => false); 
239 

240 if bytes_read = offset then 
241 

242 bytes_read := Byte_St ream_AM. Ops. Read ( 

243 opened_dev => opened_device, 

244 buffer_VA => bytes' address, 

245 length => bytes' size/8, 

24 6 block => false); 
247 

248 end if; 

249 

250 end Write_bytes; 

251 

252 

253 procedure Close_device 

254 is 

255 begin 

25 6 Byte_Stream_AM. Ops. Close (opened_device) ; 
257 end Close_device; 

258 

259 end VD Devices; 
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X-A.7.1 Acct_main_ex Procedure 

Main procedure of the account manager test driver. 



i 

2 

3 — 

4 — COMMAND DEFINITIONS 

5 — 

6 

7 : 

8 
9 

10 — *D* manage . commands 

11 — *D* 

12 — *D* 

13 — *D* 

14 — *d* create. invocation_command 

15 ~ *D* end 

16 — *D* 

17 — *D* 

18 — *D* 

19 — *D* create. runt ime_command_set :cmd_def = acct_cmds \ 

20 — *D* : prompt = "ACCT_MGT> " 

21 — *D* 

22 — *D* define. command :cmd_name = create 

23 — *D* set. description :text = " 

24 — *D* — Create a new account with an initial balance. 

25 — *D* " 

26 — *D* 

27 — *D* define. argument :arg_name = init_balance \ 

28 — *D* :type = integer 

29 — *D* set .description :text = " 

30 — *D* — Initial balance of an account. 

31 — *D* — Must be between an 100000. 

32 — *D* " 

33 — *D* set. bounds rvalue = 0.. 100000 

34 — *d* set .mandatory 

35 __* D * end 

36 ~*D* end 

37 __* D * 

38 — *d* 

39 — *D* define. command :cmd_name = cstore 

40 — *D* set .description :text = " 

41 — *D* — Create and store a new account in one step. 

42 — *d* « 

43 __* D * 

44 — *D* define. argument :arg_name = pathname \ 

45 — *D* :type = string 

46 — *D* set .description :text = " 

47 — *D* — Pathname to store the account. Must be 

48 — *D* — a valid pathname that is not already in use. 

49 — *D* — Caller must have store rights in the referenced 

50 — *D* — directory. 

51 — *D* •* 

52 — *D* set .maximum_length 43 

53 — *D* set .mandatory 

54 — *n* e nd 

55 __* D * 

56 — *D* define. argument :arg_name = init_balance \ 

57 — *d* :type = integer 

58 — *D* set .description :text = " 

59 — *D* — Initial balance of the account. Must be 

60 — *D* — greater or equal to zero and less than or equal 

61 — *d* — to 100000. 

62 — *D* " 

63 — *D* set. bounds lvalue = 0.. 100000 

64 — *D* set .mandatory 

65 — *D* end 

66 — *D* 

67 — *D* define. argument :arg_name = authority \ 

68 — *D* rtype = string 

69 — *D* set .description rtext = " 

70 — *D* — Specifies an authority list to be stored 

71 — *D* — with an account. Has to be created separately 

72 — *D* — invoking the manage. authority runtime command. 

73 — *D* — Default value is none. 
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— *n* 
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set.maximum_length 43 
set.value_default rvalue = "none* 
end 
end 



define. command :cmd_name = store 
set. description :text = " 

— Store an existing active account. 

— Causes separate command set acct_cmd_store 

— to be invoked. 



define. argument :arg_name = ref_number \ 
rtype = integer 
set. description :text = " 

— Reference to an account. Has to be 

— between 1 and 100. 



set. bounds rvalue = 
set . mandatory 
end 



,100 



define. argument rarg_name = pathname \ 
rtype = string 
set. description rtext = " 

— Pathname to store the account. Must be 

— a valid pathname that is not already in use. 

— Caller must have store rights in the referenced 

— directory. 



set .maximum_length 
set . mandat o ry 
end 



43 



define. argument rarg_name = authority \ 
rtype = string 
set. description rtext = " 

— Specifies an authority list to be stored 

— with an account. Has to be created separately 

— invoking the manage. authority runtime command. 

— Default value is none. 

set .maximum_length 43 
set.value_default rvalue = "none" 
end 
end 



define. command rcmd_name = retrieve 
set. description rtext = " 

— Retrieve a stored account from a pathname 

— and make it available for online processing. 



define. argument rarg_name = pathname \ 
rtype = string 
set .description rtext = " 

— Pathname of a account to be retrieved. Can 

— be relative, absolute, or network pathname. 

— Must be a valid pathname and pathname must 

— reference an account. 

set.maximum_length rvalue =43 
set .mandatory 
end 
end 



define. command rcmd_name = "list" 
set. description rtext = " 

— List all accounts currently available for 

— online processing by ordinal reference number. 

n 

end 
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define. command :cmd_name = display 
set. description :text = " 

— Display all relevant information about an account. 



define. argument :arg_name = ref_number \ 
:type = integer 
set .description :text = " 

— Ordinal number referencing the account 
ii 

set. bounds rvalue = 0..100 
set.value_default rvalue = 
end 
end 



define. command :cmd_name = withdraw 
set. description :text = " 

— Withdraw a given amount from an account 



define. argument :arg_name = ref_number \ 
:type = integer 

set. bounds rvalue = 1..100 

set . mandatory 
end 

define. argument rarg_name = amount \ 
rtype = integer 
set. bounds rvalue = 0.. 100000 
set .mandatory 
end 
end 



define. command rcmd_name = deposit 
set .description rtext = " 

— Deposit a given amount to an account 



define. argument rarg__name = ref_number \ 
rtype = integer 

set. bounds rvalue = 1..100 

set .mandatory 
end 

define. argument rarg_name = amount \ 
rtype = integer 
set. bounds rvalue = 0.. 100000 
set .mandatory 
end 
end 



define. command rcmd_name = transfer 
set. description rtext = " 

-- Transfer amount from source to destination. 



define. argument rarg_name = source \ 
rtype = integer 

set. bounds rvalue = 1..100 

set . mandatory 
end 

define. argument rarg_name = destination \ 
rtype = integer 

set. bounds rvalue = 1..100 

set .mandatory 
end 

define. argument rarg_name = amount \ 
rtype = integer 

set. bounds rvalue = 0.. 100000 

set. mandatory 
end 
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228 — *D* end 

229 — *D* 

230 — *D* 

231 — *D* define. command :cmd_name = remove 

232 — *D* set. description :text = " 

233 — *D* — Remove an account from online processing 

234 — *D* — Does not affect an accounts passive version. 

235 — *D* " 

236 — *D* 

237 — *D* define. argument :arg_name = ref_number \ 

238 — *D* :type = integer 

239 — *D* set. bounds :value = 1..100 

240 — *D* set. mandatory 

241 — *D* end 

242 — *D* end 

243 ~*D* 

244 ~*D* 

245 — *D* define. command :cmd_name = destroy 

246 — *D* set. description :text = " 

247 — *D* — Destroy an account's passive version. 

248 — *D* — Does not affect an account's online representation. 

249 — *D* — Fails for account's that have not been passivated. 

250 — *D* 

251 — *D* 

252 — *D* define. argument :arg_name = ref_number \ 

253 — *D* :type = integer 

254 — *D* set. bounds :value = 1..100 

255 — *D* set. mandatory 

256 — *D* end 

257 — *D* end 

258 — *D* 

259 — * D * 

260 — *D* define. command : cmd_name = manage. authority 

261 — *D* set. description :text = " 

262 — *D* — Invokes the manage. authority utility to 

263 — *D* — create authority list from within this 

264 — *D* — program. 

265 — *D* 

266 — *D* end 

267 — *D* 

268 — *D* 

269 — *D* define. command :cmd_name = save 

270 — *D* 

271 — *D* — Invokes the screensaver utility. 

272 — *D* 

273 — *D* 

274 — *D* define. argument :arg_name = "args" \ 

275 — *D* :type = string 

276 — *D* set.value_default :value = "" 

277 — *D* set. description :text = " 

278 — *D* — Arguments to pass on to screensaver 

279 — *D* — Type csh command line in quotes. 

280 — *D* " 

281 — *D* end 

282 — *D* end 

283 — *d* 

284 — *D* 

285 — *D* define. command :cmd_name = "exit" 

286 — *D* set. description :text = " 

287 — *D* — Exit accounting program 

288 — *d* 

289 — *D* end 

290 — *D* end 

291 — *D* exit 
292 

293 

294 

295 — 

296 — MESSAGE DEFINITIONS 

297 — 

298 

299 

300 

301 — *D* 

302 — *D* man age. mess ages 

303 — *D* 

304 — *D* 
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._*D* 
._*D* 
._*D* 
._*D* 
._*D* 
._*D* 
._*D* 
._*D* 
._*D* 
._*D* 
._*D* 
._*D* 
—*D* 
._*D* 
._* D * 
._* D * 
._* D * 
._*D* 
— *D* 
._*D* 
._*D* 
-_*D* 

._*D* 
._* D * 
._* D * 
-_*d* 
._*D* 
._*D* 
._*D* 
._*d* 
._*D* 
._*D* 
._*D* 
._*D* 
._*D* 
._*D* 
._* D * 
._* D * 
._*D* 
._*D* 
._* D * 
._*D* 
._* D * 
._* D * 
._* D * 
._*D* 
._* D * 
._* D * 
._*□* 
._* D * 
._* D * 
._* D * 
._* D * 
._*D* 
._* D * 
,_* D * 

._*£)* 
,_* D * 
,_*Q* 
_* D * 

_*D* 

._* D * 

_* D * 

_* D * 

_* D * 

-*D* 

-*D* 

-*D* 

-*D* 

-*D*i 

-*D* 

-*D* 

-*D* 

-*D* 

-*D* 

-*D* 



set. language : language = english 



store : module = 1 \ 
: number = 1 \ 
:msg_name = welcome \ 
: short = "Welcome to the Account Manager" 



store : module = 1 \ 
: number = 2 \ 
:msg_name = local_created \ 

: short = "Local account number $pl<ref_number> has \ 
initial balance $p2<initial_balance>. " 

store : module = 1 \ 
: number = 3 \ 

:msg_name = list_limits_exceeded \ 
: short = \ 
"You can no longer create accounts. 
Your limit of $pl<list length limit> has been exceeded." 



store 



store 



store 



store 



store 



store 



store 



store 



: module 
: number 
: msg_name 
: short 



: module 
: number 
: msg_name 
: short 



: module 
: number 
: msg_name 
: short 



: module 
: number 
:msg_name 
: short 



: module 
: number 
: msg_name 
: short 



: module 
: number 
: msg_name 
: short 



: module 
: number 
: msg_name 
: short 



: module 
: number 



: msg_name 
: short 
s $pl<new balance>' 



1 \ 

4 \ 

unrecognized_problem \ 

"An unrecognized exception has been found." 



1 \ 

5 \ 

no_access \ 

"You specified an invalid pathname." 



1 \ 

6 \ 

invalid_account \ 

"You have specified an invalid account, 



1 \ 

7 \ 

directory_entry_exists \ 

"You have specified an existing directory entry' 



1 \ 

8 \ 

no_default_authority \ 

"There is no default authority list." 



1 \ 

9 \ 

not_implemented \ 

"Operation not currently implemented." 



1 \ 
10 \ 

not_supported \ 
"Operation not supported." 



I \ 

II \ 
new_balance \ 

"The new balance in the account 



store :module = 1 \ 
: number = 12 \ 
:msg_name = acct_removed \ 
: short = \ 
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382 — *D* "Account with local number $pl<ref_number> has been removed." 

383 ~*D* 

384 — *D* 

385 — *D* store : module = 1 \ 

386 — *D* ;numb@r = 13 \ 

387 — *D* :msg_name = acct_destroyed \ 

388 — *D* : short = \ 

389 — *D* "Account with pathname $pl<pathname> has been destroyed." 

390 — *d* 

391 — *D* 

392 — *D* store :module = 1 \ 

393 — *D* : number - 14 \ 

394 — *D* :msg_name = not_account \ 

395 ~*D* : short = \ 

396 — *n* "$pl<pathname> is not an account." 

397 ~*D* 

398 ~*D* 

399 — *d* store rmodule = 1 \ 

400 — *D* :number = 15 \ 

401 — *D* :msg_name = not_type_rights \ 

402 ~*D* : short = \ 

403 — *D* "You have insufficient rights for this account." 

404 ~*D* 

405 — *D* 

406 — *D* store :module = 1 \ 

407 — *D* rnumber = 16 \ 

408 — *D* :msg_name = no_master_AD \ 

409 — *D* : short = "This operation requires that the account \ 

410 — *D* be stored." 

411 ~*D* 

412 ~*D* 

413 — *D* exit 
414 

415 with 

416 Account_Mgt_Ex , 

417 Acct_visual, 

418 Acct_Types, 

419 Authority_List_Mgt, 

420 Character_Display_AM, 

421 Command_Execution, 

422 Command_Handler, 

423 Conversion_Support_Ex, 

424 Device_Defs, 

425 Directory _Mgt, 

426 Incident_Def s f 

427 Long_Integer_Defs, 

428 Message_Services, 

429 Passive_Store_Mgt, 

430 Process_Mgt, 

431 Process_Mgt_Types, 

432 System, 

433 System_Defs, 

434 System_Exceptions, 

435 Terminal_Defs, 

436 ' Text_Mgt, 

437 Transaction_Mgt, 

438 Unchecked_conversion, 

439 Window_Services; 
440 

441 

442 procedure Acct_main_loop is 

443 

444 — Function: 

445 — Main event loop for account managing program. 
446 

447 

448 — Variables for creating and storing accounts: 

449 

450 local_list: Acct_Types. list; 

451 — List of local accounts. 

452 list_pointer: Acct_Types.acct_enum := Acct_Types.list_pointer_init; 

453 — Pointer to first free element in "local_list". 

454 ref_number: Acct_Types.acct_enum; 

455 — Pointer to current element in "local_list" . 

456 source_number: Acct_Types.acct_enum; 

457 dest_number: Acct_Types.acct_enum; 

458 list exceeded: boolean := false; 
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-- True if "list" is full, 
pathname: System_Defs.text (Acct_Types.name_length_limit) 

— Container for pathnames. 
initial_balance: integer; 

— Container for initial balances. 
long_initial_balance: Long_Integer_Def s. long_integer; 

— Container for long integers. 

amount : Long_Integer_Def s. long_integer; 

— Container for long integers. 
new_balance: Long_Integer_Def s. long_integer; 

— Container for long integers. 



— Variables for Command processing: 

input : Device_Def s . opened_device; 

— Opened device for top level command processing. 
cmd_id: System. short_ordinal; 

— Ordinal identifier for commands. 

cmd_name : System_Def s . text (Acct_Types . name_length_limit ) 

— Textual identifier for commands. 



— Variables for Window output: 



old_opened_window: 

— Standard input. 
old_window: 

— Standard input 
new opened window: 



Device_Def s.opened_device; 



Device_Defs. device; 
. underlying device. 
Device_Def s . opened_device; 

— Window for display output. 
new_window: Device_Defs. device; 

— Window for display output — underlying device. 
underlying_terminal : Device_Defs. device; 

— User terminal. 

curr_pos: Terminal_Def s.point_info; 

— Current position in the opened window. 
new_window_info: Window_Services.window_style_info; 

— Style info for new window. 



— Constants defining Window output: 



frame_buf fer: constant Terminal_ 

Terminal_ 
window_size: constant Terminal 

Terminal_ 
window_pos: constant Terminal_ 

Terminal_ 
view_pos: constant Terminal^ 

Terminal_ 
title_string: constant string := 



— Variables for authority lists: 



Defs.point_info := 
Defs.point_info' (80, 20) 
Defs.point_info := 
'Defs.point_info' (80, 10) 
Defs.point_info := 
Defs.point_info' (1, 1); 
Defs.point_info := 
Defs.point_info' (1, 1); 
'< "ACCOUNTS"; 



auth_list: Authority_list_Mgt .authority_list_AD; 

— Authority list for storing accounts. 

author ity_name: System_Defs.text (Acct_Types.name_length_limit) 

— Pathname of authority list. 

— Auxiliary variables: 



exit_status: 
aux_text : 
untyped_AD : 
args: 
cmd_line: 

— Exceptions: 



integer; 

Incident_Def s. severity_value; 

System_Defs.text (Window_Services.max_title) ; 

System. untyped_word; 

System_Def s . text (Acct_Types . name_length_limit ) 

System_Def s . text (Acct_Types . name_length_limit ) 



list_exceeded_exc: exception; 
mission_accomplished: exception; 

invalid_account : exception; 

not_implemented: exception; 

new_balance_exc: exception; 

account_removed: exception; 

account destroyed: exception; 
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not_account : 
— Conversions: 



exception; 



function Untyped_from_account is new 
Unchecked_conversion ( 

source => Account_Mgt_Ex.account_AD, 
target => System. untyped_word) ; 

function Account_from_untyped is new 
Unchecked_conversion ( 

source => System. untyped_word, 
target => Account_Mgt_Ex.account_AD) 



use Incident_Defs; — Import some frequently used defs, 
use Long_Integer_Defs; — Import long integer arithmetic. 



begin 

— Initialize account list 



Acct Types. list length limit 



for i in Acct_Types.list_pointer_init 
loop 
Text_Mgt . Set ( 

dest => local_list (i) .name, 
source => Acct_Types.empty_text) ; 

end loop; 

— Open runtime command processing: 

input := Command_Handler.Open_runtime_command_processing( 

cmd_set => System_Defs. text' (14, 14, "$OEO/acct_cmds") ) ; 

— Open window for display output: 

old_opened_window := Process_Mgt.Get_process_globals_entry ( 
slot => Process_Mgt_Types. standard_input) ; 

— Retrieve standard input. 

old_window := Character_Display_AM.Ops.Get_device_object ( 
opened_dev => old_opened_window) ; 

— Retrieve the window underlying standard input. 

underlying_terminal := Window_Services.Ops.Get_terminal ( 
window => old_window) ; 

— Retrieve underlying terminal. 

new_window := Window_Services.Ops.Create_window ( 
terminal => underlying_terminal, 

pixel_units => false, 
fb_size => frame_buffer, 

desired_window_size => window_size, 
window_pos => window_pos, 

view_pos => view_pos) ; 

Text_Mgt . Set ( 

dest => new_window_info. title, 
source => title string) ; 



Window_Services . Ops . Set_window_style ( 
window => new_opened_window, 
new_info => new_window_info, 

style_list => Window_Services.window_style_mask' 
(Window_Services. set_title => true, 
others => false) ) ; 

new_opened_window := Character_Display_AM. Ops. Open ( 
device => new_window, 
input_output => Device_Defs. output) ; 

Character_Display_AM. Ops. Clear (new_opened_window) ; 

Character_Display_AM.Ops.Move_cursor_absolute ( 
opened_dev => new_opened_window, 
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new_pos => Terminal_Defs.point_lnfo' (15,2) ) ; 

curr_pos := Terminal_Defs.point_info' (3, 5) ; 

Message_Services.Write_msg( 

msg_id => Incident_Def s.incident_code' 

(1, 1, information, System. null_word) , 
no_header => true, 
device => new_opened_window) ; 

curr_pos := Terminal_Defs.point_info' (3, 2); 



loop 
begin 

— Program block to handle exceptions. 

Command_Handler . Get_command ( 
cmd_odo => input, 
cmd_id => cmd_id, 
cmd_name => cmd_name) ; 

case cmd_id is 

— CREATE: 

when => 

— A. Get argument from command line: 

initial_balance := Command_Handler.Get_integer ( 
cmd_odo => input, 
name => System_Defs.text' (12, 12, "init_balance") ) 

— B. Check whether there is space available: 

if list_exceeded then 

— Out of space. 

RAISE list_exceeded_exc; 

else 

— Space available 
long_initial_balance := 

Long_Integer_Def s. long_integer' (0, 
System. ordinal (initial_balance) ) ; 
— Convert integer to long integer. 

— C. Create account and add to local list: 

local_list (list_pointer) .AD := 

Account_Mgt_Ex.Create_account ( 

starting_balance => long_initial_balance) ; 
local_list (list_pointer) .number := list_pointer; 
Text_Mgt . Set ( 

dest => local_list (list_pointer) -name, 

source => Acct_Types.local_text) ; 
local_list (list_pointer) .stored := false; 

if list_pointer = Acct_Types.list_length_limit then 
list_exceeded := true; 
RAISE list_exceeded_exc; 

end if; 

list_pointer := list_pointer+l; 
RAISE mission_accomplished; 
end if; 



— CSTORE: 

when 1 => 

— A. Get arguments from command line: 

initial_balance := Command_Handler.Get_integer ( 
cmd odo => input, 



Ada Examples 



X-A-227 



PRELIMINARY 



690 name => System_Defs.text' (12, 12, "init_balance") ) ; 

691 

692 Command_Handler.Get_string( 

693 cmd_odo => input, 

694 name => System_De£s.textM8, 8, "'pathname 55 ), 

695 arg_value => pathname) ; 
696 

697 Command_Handler.Get_string( 

698 cmd_odo => input, 

699 name => System_Defs.text' (9, 9, "authority"), 

700 arg_value => authority_name) ; 
701 

702 if list_exceeded then 

703 — Out of space. 

704 RAISE list_exceeded_exc; 
705 

706 else 

707 — Space available 

708 long_initial_balance : = 

709 Long_Integer_Def s.long_integer' (0, 

710 System. ordinal (initial_balance) ) ; 

711 — Convert integer to long integer. 
712 

713 if Text_Mgt .Equal <authority_name, Acct_Types.none_text) then 

714 — No authority list was specified. Use default. 

715 authJList := null; 
716 

717 else 

718 auth_list := Conversion_Support_Ex. 

719 Authority_list_from_untyped( 

720 Directory _Mgt .Retrieve (authority_name) ) ; 

721 — Retrieve authority list; 
722 

723 end if; 

724 

725 — C. Create account and add to local list: 

726 

727 local_list (list_pointer) .AD := 

728 Account_Mgt_Ex.Create_stored_account ( 

729 starting_balance => long_initial_balance, 

730 master => pathname, 

731 authority => auth_list); 
732 

733 local_list (list_pointer) .number 

734 local_list (list_pointer) .name 

735 local_list (list_pointer) .stored 
736 
737 

738 if list_pointer = Acct_Types.list_length_limit then 

739 list_exceeded := true; 

740 RAISE list_exceeded_exc; 
741 

742 end if; 

743 

744 end if; 

745 list_pointer := list_pointer+l; 

746 RAISE mission_accomplished; 
747 
748 

749 — STORE: 

750 

751 when 2 => 

752 — A. Get arguments from command line: 
753 

754 ref_number := Command_Handler.Get_integer ( 

755 cmd_odo => input, 

756 name => System_Def s.text' (10, 10, "ref_number") ) ; 
757 

758 Command_Handler . Get_string ( 

759 cmd_odo => input, 

760 name => System_Def s.text' (8, 8, "pathname"), 

761 arg_value => pathname) ; 
762 

763 Command_Handler.Get_string( 

764 cmd_odo => input, 

765 name => System_Def s.text' (8, 8, "pathname"), 

766 arg value => authority name) ; 



= list_pointer; 
= pathname; 
= true; 
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if Text_Mgt. Equal (local_list (ref_number) .name, 
Acct_Types . empty_text ) 
then 

— Unassigned account. 
RAISE invalid_account; 

end if; 

if Text_Mgt. Equal (authority_name, Acct_Types.none_text) then 

— No authority list was specified. Use default. 
auth_list := null; 

end if; 

— Enclose passive store operations in a transaction: 

Transaction_Mgt.Start_transaction; 
begin 

Directory_Mgt . Store ( 

name => pathname, 

object => Untyped_from_account ( 

local_list (ref_number) .AD) , 
aut => auth_list) ; 

Passive_Store_Mgt.Request_update ( 

obj => Untyped_from_account (local_list (ref_number) .AD) ) 

Transaction_Mgt.Commit_transaction; 
exception 

when others => 

Transact ion_Mgt.Abort_transact ion; 

RAISE; 

end; 



local_list (ref_number) . name := pathname; 
local list (ref number) . stored := true; 



— RETRIEVE: 

when 3 => 

— A. Get arguments from command line: 

Command_Handler . Get_string ( 
cmd_odo => input, 

name => System_Def s. text' (8, 8, "pathname"), 
arg_value => pathname) ; 

if list_exceeded then 

RAISE list_exceeded_exc; 

else 

— B. Retrieve account and add to local list: 

untyped_AD := Directory_Mgt .Retrieve (pathname) ; 
if not Account_Mgt_Ex . I s_account (untyped_AD) then 
RAISE not_account; 

end if; 



local_list (list_pointer) .AD := 

Account from untyped (untyped AD); 



local_list (list_pointer) .number 
local_list (list_pointer) .name 
local list (list pointer) .stored 



= list_pointer; 
= pathname; 
= true; 



long_initial_balance := Account_Mgt_Ex.Get_balance ( 

local_list (list_pointer) .AD) ; 

initial_balance := integer (long_initial_balance. 1) ; 

if list_pointer = Acct_Types.list_length_limit then 
list exceeded := true; 
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844 RAISE list_exceeded_exc; 

845 

846 end if; 

847 list_pointer := list_pointer+l; 

848 RAISE missian_aeeeHiplished? 
849 

850 end if; 

851 

852 — LIST: 

853 

854 when 4 => 

855 Character_Display_AM. Ops. Clear (new_opened_window) ; 

856 Acct_visual. Di splay _li st ( 

857 list => local_list, 

858 output => new_opened_window, 

859 pixel_units => false, 

860 location => curr_pos) ; 
861 

862 

863 

8 64 — DISPLAY: 

865 

866 when 5 => 

867 — A. Get arguments from command line: 
868 

869 ref_number := Command_Handler.Get_integer ( 

870 cmd_odo => input, 

871 name => System_Def s. text'(10, 10, "ref_number") ) ; 
872 

873 if ref_number = then 

874 ref_number := list_pointer-l; 

875 end if; 
876 

877 if Text_Mgt .Equal (local_list (ref_number) .name, 

878 Acct_Types.empty_text) 

879 then 

880 — Unassigned account. 

881 RAISE invalid_account; 
882 

883 end if; 

884 

885 Character_Display_AM. Ops. Clear (new_opened_window) ; 

886 Acct_visual. Display _account ( 

887 account => local_list (ref_number) .AD, 

888 output => new_opened_window, 

889 pixel_units => false, 

890 location => curr_pos) ; 
891 

892 

893 

894 

895 — WITHDRAW: 

896 

897 when 6 => 

898 — A. Get arguments from command line: 
899 

900 ref_number := Command_Handler.Get_integer ( 

901 cmd_odo => input, 

902 name => System_Defs.text' (10, 10, "ref_number") ) ; 
903 

904 initial_balance := Command_Handler.Get_integer ( 

905 cmd_odo => input, 

906 name => System_Defs.text' (6, 6, "amount")); 
907 

908 if Text_Mgt. Equal (local_list (ref_number) .name, 

909 Acct_Types.empty_text) 

910 then 

911 — Unassigned account. 

912 RAISE invalid_account; 
913 

914 end if; 

915 

916 amount := 

917 Long_Integer_Defs.long_integer' (0, 

918 System. ordinal (initial_balance) ) ; 

919 — Convert integer to long integer. 
920 
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new_balance := Account_Mgt_Ex.Change_balance ( 
account => local_list (ref_number) .AD, 
amount => - amount ) ; 

RAISE new balance exc; 



~ DEPOSIT: 

when 7 => 

— A. Get arguments from command line: 

ref_number := Command_Handler.Get_integer ( 
cmd_odo => input, 
name => System_Def s. text' (10, 10, "ref_number") ) 

initial_balance := Command_Handler.Get_integer { 
cmd_odo => input, 
name => System_Defs.text' (6, 6, "amount")); 

if Text_Mgt. Equal (local_list (ref_number) .name, 
Acct_Types . empty_text ) 
then 

— Unassigned account. 
RAISE invalid_account; 

end if; 

amount : = 

Long_Integer_Defs.long_integer' (0, 
System. ordinal (initial_balance) ) ; 

— Convert integer to long integer. 

new_bal ance : = Account_Mgt_Ex . Change_bal ance ( 
account => local_list (ref_number) .AD, 
amount => amount) ; 

RAISE new balance exc; 



— TRANSFER: 

when 8 => 

— A. Get arguments from command line: 

source_number := Command_Handler.Get_integer ( 
cmd_odo => input, 
name => System_Defs.text' (6, 6, "source") ) ; 

dest_number := Command_Handler.Get_integer ( 
cmd_odo => input, 
name => System_Defs.text' (11, 11, "destination") ) 

initial_balance := Command_Handler.Get_integer ( 
cmd_odo => input, 
name => System_Defs.text' (6, 6, "amount")); 

if Text_Mgt. Equal (local_list (source_number) .name, 
Acct_Types.empty_text) or 
Text_Mgt . Equal (local_list (dest_number) .name, 
Acct_Types . empty_text ) 
then 

— Unassigned account. 
RAISE invalid_account; 

end if; 

amount : = 

Long_Integer_Defs.long_integer' (0, 
System. ordinal (initial_balance) ) ; 

— Convert integer to long integer. 

Account_Mgt_Ex. Transfer ( 

source_account => local_list (source_number) .AD, 
dest_account => local_list (dest_number) .AD, 
amount => amount) ; 



Ada Examples 



X-A-231 



PRELIMINARY 



998 
999 
1000 
1001 
1002 
1003 
1004 
1005 
1006 
1007 
1008 
1009 
1010 
1011 
1012 
1013 
1014 
1015 
1016 
1017 
1018 
1019 
1020 
1021 
1022 
1023 
1024 
1025 
1026 
1027 
1028 
1029 
1030 
1031 
1032 
1033 
1034 
1035 
1036 
1037 
1038 
1039 
1040 
1041 
1042 
1043 
1044 
1045 
1046 
1047 
1048 
1049 
1050 
1051 
1052 
1053 
1054 
1055 
1056 
1057 
1058 
1059 
1060 
1061 
1062 
1063 
1064 
1065 
1066 
1067 
1068 
1069 
1070 
1071 
1072 
1073 
1074 



~ REMOVE: 

when 9 => 

— A. Get arguments from command line: 

ref_number := Command_Handler.Get_integer ( 
cmd_odo => input, 
name => System_Defs.text' (10, 10, "refjnumber") ) 

if Text_Mgt .Equal (local_list (ref_number) .name, 
Acct_Types . empty_text ) 
then 
— Unassigned account. 
RAISE invalid_account; 

end if; 

Text_Mgt . Set ( 

dest => local_list (ref__number) .name, 
source => Acct_Types.empty_text) ; 

RAISE account removed; 



-- DESTROY:' 

when 10 => 

— A. Get arguments from command line: 

ref_number := Command_Handler.Get__integer ( 
cmd_odo => input, 
name => System_Defs.text' (10, 10, "ref_number") ) ; 

if Text_Mgt .Equal (local_list (ref_number) .name, 
Acct_Types . empty_text ) 
then 
— Unassigned account. 
RAISE invalid_account; 

end if; 

Account_Mgt_Ex.Destroy_account (local_list (ref_number) .AD) ; 

Text_Mgt . Set ( 

dest => local_list (ref_number) .name, 
source => Acct_Types.empty_text) ; 

RAISE account destroyed; 



— MANAGE. AUTHORITY: 

when 11 => 

exit_status := Command_Execution.Execute_command ( 

command => System_Defs.text' (16, 16, "manage. authority") ) 

« SAVE: 

when 12 => 

— A. Get arguments from command line: 

Command_Handler . Get_string ( 
cmd_odo => input, 

name => System_Defs.text' (4, 4, "args"), 
arg_value => args) ; 

Text_mgt . Set ( 

dest => cmd_line, 
source => "ss ") ; 

Text_Mgt . Append ( 

dest -> cmd_line, 
source => args) ; 
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exit_status := Command_Execution.Execute_command( 
command => cmd line) ; 



— EXIT: 



when 13 => 
EXIT; 

when others => 

RAISE not_implemented; 

end case; 



exception 

— Main exception handler: 

— LOCAL: 

when account_destroyed => 
Text_Mgt . Set ( 

dest => aux_text, 

source => pathname) ; 

Message_Services.Write_msg( 

msg_id => Incident_Def s. incident_code' 

(1, 13, information, System. null_word) , 
paraml => Incident_Def s.message_parameter' 

(txt, pathname. length, aux_text) , 
no_header => true) ; 

when account_removed => 

Message_Services.Write_msg( 

msg_id => Incident_Defs.incident_code' 

(1, 12, information, System. null_word) , 
paraml => Incident_Defs.message_parameter' 

(int, 4, integer (ref_number) ) , 
no_header => true) ; 

when invalid_account => 

Message_Services.Write_msg( 

msg_id => Incident_Defs.incident_code' 

(1, 6, error, System. null_word) , 
no_header => true) ; 

when list_exceeded_exc => 

Message_Services.Write_msg( 

msg_id => Incident_Defs. incident_code' 

(1, 3, warning, System. null_word) , 
paraml => Incident_Defs.message_parameter' 

(int, 4, Acct_Types.list_length_limit) , 
no_header => true) ; 

when mission_accomplished => 
Message_Services.Write_msg( 

msg_id => Incident_Defs.incident_code' 

(1, 2, information, System. null_word) , 
paraml => Incident_Defs.message_j>arameter' 

(int, 4, list_pointer-l) , 
param2 ==> Incident_Defs.message_parameter' 

(int, 4, initial_balance) , 
no_header => true) ; 

when new_balance_exc => 

Message_Services.Write_msg ( 

msg_id => Incident_Defs. incident_code' 

(1, 11, warning, System. null_word) , 
paraml => Incident_Defs.message_parameter' 

(int, 4, integer (new_balance. 1) ) , 
no_header => true) ; 

when not_account => 
Text_Mgt . Set ( 

dest => aux_text, 
source => pathname) ; 
Message Services. Write msg ( 
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msg_id 
paraml 



=> Incident_Defs.incident_code' 

(1, 14, error, System. null_word) , 

=> Incident_Def s . message_parameter' 
(txt, pathname. length, aux_text) , 

r — ^ true) ; 



when not_implemented => 

Message_Services .Write_msg ( 

msg_id => Incident_Defs.incident_code' 

(1, 9, warning, System. null_word) , 
no. header => true); 



— ACCOUNT_MGT_EX: 

when Account_mgt_Ex.balance_not_zero => 
Message_Services.Write_msg ( 

msg_id => Incident_Defs.incident_code' 

(0, 2, error, System. null_word) , 
no_header => true) ; 

when Account_Mgt_Ex.insufficient_balance => 
Message_Services.Write_msg ( 

msg_id => Incident_Defs.incident_code' 

(0, 1, error, System. null_word) , 
no_header => true) ; 

— DIRECTORY_MGT: 

when Directory_Mgt. entry _exists => 
Message_Services.Write_msg ( 

msg_id => Incident_Defs. incident_code' 

(1, 7, error, System. null_word) , 
no_header => true) ; 

when Directory _Mgt . no_access => 
Message_Services.Write_msg( 

msg_id => Incident_Defs.incident_code' 

(1, 5, error, System. null_word) , 
no_header => true) ; 

when Directory_Mgt.no_default_authority_list => 
Message_Services.Write_msg ( 

msg_id => Incident_Def s. incident_code' 

(1, 8, error, System. null_word) , 
no_header => true) ; 

— PASSIVE_STORE_MGT : 

when Passive_Store_Mgt .no_master_AD => 
Message_Services. Write_msg ( 

msg_id => Incident_Def s. incident_code' 

(1, 16, error, System. null_word) , 
no_header => true) ; 

-- SYSTEM_EXCEPTIONS: 

when System_Exceptions.insufficient_type_rights => 
Message_Services. Write_msg ( 

msg_id => Incident_Defs.incident_code' 

(1, 15, warning. System. null_word) , 
no_header => true) ; 

when System_Exceptions.operation_not_supported => 
Message_Services . Write_msg ( 

msg_id => Incident_Def s. incident_code' 

(1, 10, warning, System. null_word) , 
no_header => true) ; 

when others => 

Message_Services.Write_msg( 

msg_id => Incident_Defs.incident_code' 

(1, 4, error, System. null_word) , 
no_header => true) ; 
RAISE; 



end; 
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1229 end loop; 

1230 

1231 end Acct_main_loop; 

1232 
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X-A.7.2 Acct_yisual Package Specification 

Display routines used by the account manager test driver. 



i 

2 

3 
4 
5 
6 

7 
8 
9 

10 
11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 
40 
41 
42 
43 
44 
45 
46 
47 
48 
49 
50 
51 
52 
53 
54 
55 
56 
57 
58 
59 
60 
61 
62 
63 
64 
65 
66 
67 
68 
69 
70 
71 
72 
73 



with 

Account_Mgt_Ex , 

AcctJTypes, 

Author! ty_List_Mgt , 

Device_Defs, 

Long_Integer_Defs, 

System_Defs, 

Terminal_Defs; 

package Acct_visual is 

— Function: 

This package contains procedures to display 
information about accounts. It is called by the 

— Acct_main procedure. 

— Calls: 

o Display_account Given an AD displays all information relevant to 
the account, i. e. pathname, creator, creation, 
creation time, time last read, time last modified. 
and the current balance. 

o List_account Given a Acct_main. list, displays that list. 

— Exceptions: 

procedure Display_account ( 

account : Account_Mgt_Ex . account_AD ; 

— Account that is to be displayed, 
output : Device_Def s . opened_device; 

— Device to use for displaying info. 
pixel_units: boolean := false; 

— Whether to use character- or pixel units, 
location: Terminal_Def s.point_info) ; 

— Where to display the account. 

— Function: 

Displays relevant information about an account 
in the following format: 



NAME: 
CREATOR: 
CREATED : 
LAST READ: 
LAST MODIFIED 



///bla/bla/acct/bozol 
///bla/bla/id/bozo 
12/12/1212 15:43:59 
12/12/1212 15:43:59 
12/12/1212 15:43:59 



Current Balance: 



$ 146358.00 



For accounts that have no passive version the display will 
look like this: 



NAME: 
CREATOR: 
CREATED : 
LAST READ: 
LAST MODIFIED: 



local 



Current Balance: 



$ 146358.00 



procedure Display_list ( 

list: Acct_Types.list; 

— List to display. 

output: Device_Def s. opened_device; 

— Device to use for displaying info. 
pixel_units: boolean := false; 

— Whether to use character- or pixel units, 
location: Terminal Defs. point info); 
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74 — Where to display the list. 

75 

76 — Function: 

77 — Displays a list of local account in the following format: 
78 

79 — <ref_number> <stored> <name> 

80 — 1 stored ///Gemini/State/home/tobiash/savings 

81 — 2 local ///Gemini/State/home/martinb/checking 

82 — 3 stored ///Gemini/State/home/patty/stocks 
83 

84 

85 

86 pragma external; 

87 

88 end Acct visual; 



Ada Examples X-A-237 



I" JX£<1jJL1V11.1^/VJCV X 



X-A.7.3 Acct_visual Package Body 

Display routines used by the account manager test driver. 
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— *D* manage. messages 

— *D* 

— *D* store : module = 2 \ 

— *D* : number = 1 \ 

— *D* :msg_name = acknowledge \ 

— *D* : short = "Type any character to continue> 

— *D* exit 

with 

Account_Mgt_Ex , 

Acct_Types, 

Character_Display_AM, 

Device_Defs, 

Directory_Mgt, 

Incident_Defs, 

Long_Integer_Def s, 

Message_Services, 

Passive_Store_Mgt, 

System, 

System_Def s, 

System_Exceptions, 

Terndnal_Defs, 

Text_Mgt , 

Timing_Conversions, 

Timing_String_Conversions; 



package body Acct visual is 



procedure Display_account ( 

account : Account_Mgt_Ex . account_AD ; 
output : Devi ce_De f s . opened_devi ce ; 
pixel_units: boolean := false; 
location: in Terminal_Defs.point_info) 
is 

account_untyped: System. untyped_word; 

FOR account_untyped USE AT account' address; 
— Untyped overlay. 

account_info: Passive_Store_Mgt.passive_object_info; 

name_value : System_Def s . text (Acct_Types . name_length_ 

creator_value : System_Def s . text (Acct_Types . name_length_ 

created_value: System_Defs.text (22) 

read_value: System_Defs.text (22) 

write_value: System_Def s.text (22) 

bal_value: Long_Integer_Defs.string_integer; 

num_time: Timing_conversions.numeric_time; 



no_name: boolean := false; 
position: Terminal_Defs.point_info; 
ID_untyped: System. untyped_word; 

FOR id_untyped USE AT account_info. owner' address; 
num_bal : Long_Integer_Def s. long_integer; 

tb_line: constant System_Def s.text := System_Defs. 



limit) ; 
limit) ; 



side: constant 

"I"); 
name: constant 

"NAME : " ) ; 
creator: constant 

"CREATOR:") ; 
created: constant 

"CREATED:") ; 
read: constant 

"LAST READ:"); 
write: constant 

"LAST MODIFIED: 
bal: constant 



System_Def s . text 

System_Def s . text 

System_Def s . text 

System_Def s . text 

System_Def s . text 

System_Def s . text 

"); 

System Def s.text 



:= System_Defs. 
:= System_Defs. 
: = System_Defs. 
:= System_Defs. 
:= System_Defs. 
:= System_Defs, 
:= System Defs. 
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"CURRENT BALANCE: $"); 

begin 

— 1. Display account template: 

position := location; 

Character_Display_AM. Ops. Clear_to_bottom (output) ; 

Character_Display_AM.Ops.Move_cursor_absolute ( 

opened_dev => output, 

new_pos => position) ; 
Character_Display_AM. Ops. Write ( 

— Top line of box. 
opened_dev => output, 

buffer_VA => tb_line. value' address, 

length => System. ordinal (tb_line. length) ) 

for i in 1 . . 7 loop 

position. vert := location. vert+i; 
position. horiz := location. horiz; 
Character_Di spl ay_AM . Ops . Move_cursor_absolute ( 

opened_dev => output, 

new_pos => position) ; 
Character_Display_AM. Ops. Write ( 

— Left side of box 
opened_dev => output, 
buffer_VA => side. value' address, 

length => System. ordinal (side. length) ) ; 

position. horiz := location. horiz+74; 
Character_Display_AM. Ops . Move_cursor_absolute ( 

opened_dev => output, 

new_pos => position) ; 
Character_Display_AM. Ops. Write ( 

— Right side of box. 
opened_dev => output, 
buffer_VA => side. value' address, 

length => System. ordinal (side. length) ) ; 

end loop; 

position. vert := location. vert+8; 
position. horiz := location. horiz; 
Character_Display_AM.Ops.Move_cursor_absolute ( 

opened_dev => output, 

new_pos => position) ; 
Character_Display_AM. Ops. Write ( 

— Bottom line of box. 
opened_dev => output, 

buffer_VA => tb_line. value' address, 

length => System. ordinal (tb_line. length) ) 

position. horiz := location. horiz+1; 

position. vert := location. vert+1; 

Charact er_Di spl ay_AM . Ops . Move_cursor_absolute ( 

opened_dev => output, 

new w pos => position) ; 
Charact er_Di spl ay_AM. Ops. Write ( 

— Write "NAME:" in position 2,2. 
opened_dev => output, 
buffer_VA => name. value' address, 

length => System. ordinal (name . length) ) ; 

position. vert := position. vert+1; 

Charact er_Di spl ay_AM. Ops. Move_cursor_absolute ( 

opened_dev => output, 

new_pos => position) ; 
Character_Display_AM. Ops. Write ( 

— Write "CREATOR:" in position 3,2. 
opened_dev => output, 

buffer_VA => creator. value' address, 

length => System. ordinal (creator. length) ) 

position. vert := position. vert+1; 
Character_Display_AM.Ops.Move_cursor_absolute ( 

opened_dev => output, 

new_pos => position) ; 
Character_Display_AM. Ops. Write ( 
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151 — Write "CREATED:" in position 4,2. 

152 opened_dev => output, 

153 buffer_VA => created. value' address, 

154 length => System. ordinal (created. length) ) ; 
155 

156 position. vert := position. vert+1; 

157 Character_Display_AM.Ops.Move_cursor_absolute ( 

158 opened_dev => output, 

159 new_pos => position); 

160 Character_Display_AM. Ops. Write ( 

161 -- Write "LAST READ:" in position 5,2. 

162 opened_dev -> output, 

163 buffer_VA => read. value' address, 

164 length => System. ordinal (read. length) ) ; 
165 

166 position. vert := position. vert+1; 

167 Character_Display_AM.Ops.Move_cursor_absolute ( 

168 opened_dev => output, 

169 new_pos => position); 

170 Character_Display_AM. Ops. Write ( 

171 — Write "LAST MODIFIED:" in position 6,2. 

172 opened_dev => output, 

173 buffer_VA => write. value' address, 

174 length => System. ordinal (write. length) ) ; 
175 

176 position. vert := position. vert+2; 

177 Character_Display_AM.Ops.Move_cursor_absolute ( 

178 opened_dev => output, 

179 new_pos => position) ; 

180 Character_Display_AM. Ops. Write ( 

181 — Write "CURRENT BALANCE: $" in position 8,2. 

182 opened_dev => output, 

183 buffer_VA => bal .value' address, 

184 length ~> System. ordinal (bal. length) ) ; 
185 

186 
187 

188 — 2. Determine whether "account_AD" references an account 

189 — with a passive version. If yes, get the account's name: 
190 

191 begin 

192 — This block controls the scope of the exception handler. 

193 Di rectory _Mgt .Get_name ( 

194 obj => account_untyped, 

195 name => name_value) ; 
196 

197 exception 

198 when Directory_Mgt.no_name => 

199 Text_Mgt . Set ( 

200 dest => name_value, 

201 source => Acct_Types. local_text) ; 

202 no_name := true; 
203 

204 when others => 

205 RAISE; 
206 

207 end; 

208 

209 

210 — 3. Initialize values for 

211 — - Creator 

212 — - Creation Time 

213 — - Time Last Read 

214 ~ - Time Last Modified 

215 — - Current Balance 

216 — If account is unnamed initialize to "local". 
217 

218 if no_name then 

219 — Account has no name and therefore has not 

220 — been passivated. 

221 Text_Mgt . Set ( 

222 dest => creator_value, 

223 source => Acct_Types.local_text) ; 

224 Text_Mgt . Set ( 

225 dest -> created_value, 

226 source => Acct_Types.local_text) ; 

227 Text Mgt.Set( 
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dest => read_value, 
source => Acct_Types.local_text) ; 
Text_Mgt . Set ( 

dest => write_value, 

source => Acct_Types.local_text) ; 

else 

— Account has a name and has been passivated. 

account_info := Passive_Store_Mgt.Request_passive_object_info ( 
ob j => account_untyped) ; 

Directory_Mgt . Get_name ( 

— Obtain user name of owner from ID. 
obj => ID_untyped, 
name => creator_value) ; 

num_tlme := Timing_Conversions.Convert_stu_to_numeric_time ( 

stu => account_info.create_time) ; 
Timing_string_conversions.Convert_numeric_time_to_ISO ( 

num_time => num_time, 

ISO_time => created_value) ; 

num_time := Timing_Conversions.Convert_stu_to_numeric_time ( 

stu => account_info.read_time) ; 
Timing_string_conversions.Convert_numeric_time_to_ISO ( 

num_time => num_time, 

ISO_time => read_value) ; 

num_time := Timing_Conversions.Convert_stu_to_numeric_time ( 

stu => account_info.write_time) ; 
Timing_string_conversions.Convert_numeric_time_to_ISO ( 

num_time => num_time, 

ISO_time => write_value) ; 
end if; 

— 4. Get balance and convert to suitable format: 

num_bal := Account_Mgt_Ex.Get_balance (account) ; 

Long_Integer_Def s . Long_integer_image ( 
number => num_bal, 
image => bal_value) ; 

— 5. Display values: 

position. horiz := location. horiz+9; 
position. vert := location. vert+1; 
Character_Display_AM.Ops.Move_cursor_absolute ( 

opened_dev => output, 

new_pos => position) ; 
Character_Display_AM. Ops. Write ( 

opened_dev => output, 

buffer_VA => name_value. value' address, 

length => System. ordinal (name_value. length) ) ; 

position. horiz := location. horiz+16; 
position. vert := position. vert+1; 
Character_Di splay _AM. Ops. Move_cursor_absolute ( 

opened_dev => output, 

new_pos => position) ; 
Character_Display_AM. Ops. Write ( 

opened_dev => output, 

buffer_VA => creator_value. value' address, 

length => System. ordinal (creator_value. length) ) ; 

position. vert := position. vert+1; 
Character_Di splay _AM. Ops. Move_cursor_absolute ( 

opened_dev => output, 

new_pos => position) ; 
Character_Display_AM. Ops. Write { 

opened_dev => output, 

buffer_VA => created_value. value' address, 

length => System. ordinal (created_value. length) ) ; 

position. vert := position. vert+1; 
Character_Di splay_AM . Ops . Move_cursor_absolut e ( 
opened dev => output, 
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305 new_jpos => position) ; 

306 Character_Display_AM. Ops. Write ( 

307 opened_dev => output, 

308 buffer^VA => read = value. value' address, 

309 length => System. ordinal (read_value. length) ) ; 
310 

311 position. vert := position. vert+1; 

312 Character_Display_AM.Ops.Move_cursor_absolute ( 

313 opened_dev => output, 

314 new_pos => position) ; 

315 Character_Display_AM. Ops. Write ( 

316 opened_dev => output, 

317 buffer_VA => write_value. value' address, 

318 length => System. ordinal (write_value. length) ) ; 
319 

320 position. vert := position. vert+2; 

321 position. horiz := location. horiz+20; 

322 Character_Display_AM.Ops.Move_cursor_absolute ( 

323 opened_dev => output, 

324 new_pos => position) ; 

325 Character_Display_AM. Ops. Write ( 

326 opened_dev => output, 

327 buffer_VA => bal_value' address, 

328 length => 31); 
329 

330 end Display_account; 

331 

332 

333 

334 procedure Display_list ( 

335 list: Acct_Types.list; 

336 — List to display. 

337 output: Device_Def s.opened_device; 

338 — Device to use for displaying info. 

339 pixel_units: boolean := false; 

340 — Whether to use character- or pixel units. 

341 location: Terminal_Defs.point_info) 

342 — Where to display the list. 
343 

344 is 

345 

346 

347 — Auxiliary variables: 

348 

349 i: integer; 

350 cur_pos: Terminal_Def s.point_info; 

351 yes: boolean; 

352 number: System_Def s. text (5) ; 

353 step: integer; 

354 act_len: integer; 
355 

356 
357 

358 begin 

359 step := 0; 

360 cur_pos. horiz := 1; 

361 cur_pos.vert := location. vert; 

362 Character_Display_AM.Ops.Move_cursor_absolute ( 

363 opened_dev => output, 

364 new_pos => cur_pos) ; 

365 Character_Display_AM. Ops. Clear_to_bottom (output) ; 
366 

367 cur_pos := location; 

368 Character_Display_AM.Ops.Move_cursor_absolute ( 

369 opened_dev => output, 

370 new_pos => cur_pos) ; 
371 

372 for i in Acct_Types. list_pointer_init .. 

373 Acct_Types.list_length_limit loop 
374 

375 if not Text_Mgt. Equal (list (i) .name, Acct_Types.empty_text) then 

376 act_len := integer' image (list (i) .number) ' length; 
377 

378 declare 

379 aux_str: string (1. .act_len) ; 

380 begin 

381 aux str := integer' image (list (i) .number) ; 
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382 Text_Mgt . Set ( 

383 dest => number, 

384 source => aux_str) ; 

385 end; 
386 

387 step := step+1; 

388 cur_pos.vert := location. vert + (step mod 8); 

389 cur_pos.horiz := location. horiz+3; 

390 Character_Display_AM.Ops.Move_cursor_absolute ( 

391 opened_dev => output, 

392 new_pos => cur_pos) ; 

393 Character_Display_AM. Ops. Write ( 

394 opened_dev => output, 

395 buffer_VA => number. value' address, 

396 length => System. ordinal (number. length) ) ; 
397 

398 cur_pos.horiz := cur_pos.horiz+5; 

399 Character_Display_AM.Ops.Move_cursor_absolute ( 

400 opened_dev => output, 

401 new_pos => cur_pos) ; 
402 

403 if list (i) .stored then 

404 Character_Display_AM. Ops. Write ( 

405 opened_dev => output, 

40 6 buffer_VA => Acct_Types. stored_text. value' address, 

407 length => System. ordinal (Acct_Types. stored_text . length) ) ; 

408 

409 end if; 

410 

411 cur_pos.horiz := cur_pos.horiz+Acct_Types. stored_text .length+2; 

412 Character_Display_AM.Ops.Move_cursor_absolute ( 

413 opened_dev => output, 

414 new_pos => cur_pos) ; 

415 Character_Display_AM. Ops. Write ( 

416 opened_dev => output, 

417 buffer_VA => list (i) .name. value' address, 

418 length => System. ordinal (list (i) .name. length) ) ; 
419 

420 if step mod 7=0 then 

421 yes := Message_Services.Acknowledge_msg( 

422 msg_id => Incident_Def s.incident_code' 

423 (2, 1, Incident_Defs. information, System. null_word) ) 

424 cur_pos.horiz := 1; 

425 cur_pos.vert := location. vert; 

426 Character_Display_AM.Ops.Move_cursor_absolute ( 

427 opened_dev => output, 

428 new_pos => cur_pos) ; 

429 Character_Di splay _AM. Ops. Clear_to_bottom (output) ; 
430 

431 end if; 

432 

433 end if; 

434 

435 end loop; 

436 

437 end Display_list; 

438 

439 end Acct visual; 
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X-A.7.4 Account Manager Command File 

Account manager command file. 

1 set. program acct 

2 create. invocation_command 

3 — :set_def = acct_cmds 
4 

5 — Invokes the Account Manager. 
6 

7 end 
8 
9 
10 

11 create. runt ime_command_set' :cmd_def = acct_cmds \ 

12 : prompt = "ACCT_MGT> " 
13 

14 — Runtime commands of the account manager. 

15 

16 

17 

18 define. command :cmd_name = create 

19~ 

20 — Create a new account with an initial balance. 

21 

22 define. argument :arg__name = init_balance \ 

23 :type = integer 

24 set. bounds :value = 0.. 100000 

25 set. mandatory 

26 set. description :text = " 

27 — Initial balance of an account. 

28 — Must be between an 100000. 
29 

30 end 

31 set .description :text = " 

32 — Description: 

33 — Creates a local account with an initial balance. 

34 — Account is not stored and will go away when program 

35 — terminates unless it is stored prior to exiting. 
36 

37 — Examples: 

38 — *> create 10000 

39 — Creates an account with an initial balance of 10000. 
40 

41 — See Also: 

42 

43 

44 end 

45 

46 

47 define. command :cmd_name = cstore 

48 

49 — Create and store a new account in one step. 

50 

51 

52 define. argument :arg_name = pathname \ 

53 :type = string 

54 set .maximum_length 43 

55 set .mandatory 

56 set .description :text = " 

57 — Pathname to store the account. Must be 

58 — a valid pathname that is not already in use. 

59 — Caller must have store rights in the referenced 

60 — directory. 
61 

62 end 
63 

64 define. argument :arg_name = init_balance \ 

65 :type = integer 

66 set. bounds rvalue = 0.. 100000 

67 set .mandatory 

68 set .description :text = " 

69 — Initial balance of the account. Must be 

70 — greater or equal to zero and less than or equal 

71 « to 100000. 
72 

73 end 
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define. argument :arg_name = authority \ 
:type = string 
set .maximum_length 43 
set .value_default rvalue = "none" 
set .description :text = " 

— Specifies an authority list to be stored 

— with an account. Has to be created separately 

— invoking the manage. authority runtime command. 

— Default value is none. 
it 

end 

set. description rtext = " 

— Description: 

CSTORE creates a local account with an initial balance 

— and stores the account with a pathname. The pathname must 
reference an existing directory and must not already be 
in use. The implementation must support stored accounts, 

— otherwise System_Exceptions.operation_not_supported will 
be raised. 

— Examples: 

*> cstore 10000 al 

— Creates an account called al with an initial balance of 
10000 

— See Also: 



end 

define. command :cmd_name = store 
— Store an existing local account 



define. argument :arg_name = ref_number \ 
:type = integer 
set .description :text = " 

— Reference to an account. Has to be 

— between 1 and 100. 
» 

set. bounds rvalue = 1..100 
set . mandatory 
end 

define. argument :arg_name = pathname \ 
:type = string 
set .description rtext = " 

— Pathname to store the account. Must be 

— a valid pathname that is not already in use. 

— Caller must have store rights in the referenced 

— directory. 



set . maximum_length 
set .mandatory 
end 



43 



define. argument :arg_name = authority \ 
:type = string 
set .description :text = " 

— Specifies an authority list to be stored 

— with an account. Has to be created separately 

— invoking the manage. authority runtime command. 

— Default value is none. 

set .maximum_length 43 

set. value_de fault : value = "none" 
end 
set. description :text = " 

— Description: 

— Store an existing active account. 

The implementation must support stored accounts. 
Otherwise this operation will fail and the 
'System_Exceptions. operation' will be raised. 
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Examples: 

*> store :ref_number = 3 :pathname = pl77 
Stores an account that has previously been 
created and assigned local number 3 with 



— See Also: 



end 



define. command :cmd_name = retrieve 

— Make a stored account available for processing. 

define. argument :arg_name = pathname \ 
:type = string 
set. description :text = " 

— Pathname of a account to be retrieved. Can 

— be relative, absolute, or network pathname. 

— Must be a valid pathname and pathname must 

— reference an account. 
ii 

set. maximum_length .: value = 43 

set .mandatory 
end 
set .description :text = " 

— Description: 

Retrieve a stored account from a pathname 
and make it available for online processing. 

— Examples: 

*> retrieve :pathname = pl77 
Retrieves account named 'pl77' in the current 
working directory and places it on the local list 
with the lowest available local number, 'pathname' 
must reference an account. Otherwise operation fails. 

— See Also: 



end 



define. command :cmd_name = "list" 

— List all accounts available for local processing. 

set .description :text = " 

— Description: 

List all accounts currently available for 

— online processing by ordinal reference number. 

— Examples: 

— See Also: 

it 

end 

define. command :cmd_name = display 

— Display all relevant information about an account. 

define. argument :arg_name = ref_number \ 
:type = integer 
set .description :text = " 

— Ordinal number referencing a local account 
ii 

set. bounds :value = 0..100 

set .value_de fault : value = 
end 
set. description :text = " 

— Description: 
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Display all relevant information about an account. 

This is 

NAME 

CREATOR 

CREATED 

LAST READ 

LAST MODIFIED 



full network pathname, 
full name of owner, 
time when created. 
time when last read. 
time when last modified. 



CURRENT BALANCE current balance in account. 
Examples: 
See Also: 



end 

define. command :cmd_name = withdraw 

— Withdraw amount from local account. 

define. argument :arg_name = ref_number \ 
:type = integer 
set. bounds rvalue = 1..100 
set. mandatory 
set. description :text = " 

— Reference to a local account from which 

— 'amount' is to be withdrawn. 

end 

define. argument :arg_name = amount \ 
:type = integer 
set. bounds rvalue = 0.. 100000 
set .mandatory 
set .description :text = " 

— Amount to be withdrawn. Must be less than 

— the current balance in the account. 

end 

set .description :text = " 

— Description: 

Withdraw a given amount from a local account. 

— 'amount' must be less than the current balance 

in the account. Otherwise the operation will fail. 

— Examples: 

— See Also: 



end 

define. command : cmd_name = deposit 

— Deposit amount in local account. 

define. argument :arg_name = ref_number \ 
:type = integer 
set. bounds :value = 1..100 
set. mandatory 
set .description :text = " 

— Reference to a local account in which 

— 'amount' is to be deposited. 

n 

end 

define. argument :arg_name = amount \ 
:type = integer 
set. bounds :value = 0.. 100000 
set -mandatory 
set. description :text = " 

— Amount to be deposited. 
i> 

end 

set .description :text = " 
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— Description: 

Deposits a given amount in a local account, 

— Examples: 

— See Also: 



end 

define. command :cmd_name = transfer 

— Transfers an amount from one account to another. 

define. argument :arg_name = source \ 
:type = integer 
set. bounds : value = 1..100 
set. mandatory 
set. description :text = " 

— Source account for the transfer. The current 

— balance in this account must cover the transfer. 
ii 

end 

define. argument :arg_name = destination \ 
:type = integer 
set „bounds ; value = 1..100 
set .mandatory 
set. description :text = " 

— Destination account for the transfer. 
ii 

end 

define. argument :arg_name = amount \ 
:type = integer 
set. bounds :value = 0.. 100000 
set. mandatory 
set .description :text = " 

— Amount to be transferred from 'source' to 'dest'. 

end 

set .description :text = " 

— Description: 

Transfers 'amount' from 'source' to 'dest'. Transfer 
happens as one atomic operation in implementations that 
use transactions. 

— Examples: 

— See Also: 



end 

define. command :cmd_name = remove 

— Remove an account from the online processing. 

define. argument :arg_name = ref_number \ 

:type = integer 

set. bounds :value = 1..100 

set .mandatory 

set. description :text = " 

— Reference to a local account. 
ii 

end 

set .description :text = " 

— Description: 

Remove an account from online processing 
Does not affect an accounts passive version. 

— Examples: 

— See Also: 
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end 



define. command :cmd_name = destroy 

— Destroy an account. 

define. argument :arg_name = ref_number \ 
:type = integer 

set. bounds : value = 1..100 

set . mandatory 
end 
set .description :text «■ " 

— Description: 

Destroys an account's passive version 

if the implementation supports stored accounts. 

Otherwise deallocates the account. 

A stored account still has an online version 

after a 'destroy'. 

— Examples: 

— See Also: 



end 

define. command :cmd_name = manage. authority 

— Invokes the 'manage. authority' utility. 

set .description :text = " 

— Description: 

— Examples: 

— See Also: 

it 

end 

define. command :cmd_name = save 

— Invoke screensaver utility. 



define. argument :arg_name = "args" \ 
:type = string 
set. description :text = " 

— Arguments to be passed on to 

— screensaver utility. Type 

— arguments exactly as you would 

— if you invoked the screensaver 

— from a shell, except enclose the 

— arguments in quotes. 
ii 

end 
end 



define. command :cmd_name = "exit' 

— Exits 'acct' 

set. description :text = " 

— Description: 

— Examples: 

— See Also: 



end 
end 
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X-A.7.5 Account_Types_Ex Package Specification 



1 with 

2 Account_Mgt_Ex, 

3 System_Defs; 
4 

5 package Acct_Types is 

6 

7 — Global type definitions and constants for accounting program. 



9 
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— Constants: 

name_length_limit: constant 

list__length_limit: constant 

message_length: constant 

list_pointer_init: constant 

empty_text : constant 

none_text: constant 

local_text: constant 

stored text: constant 



:= 43; 

:= 100; 
:= 55; 
:= 1; 

System_Defs.text := 

System_Defs.text' (5, 5, "empty"); 

System_Defs.text := 

System_Def s.text' (4, 4, "none"); 

System_Defs.text := 

System_Def s.text' (5, 5, "local"); 

System_Def s.text := 

System_Def s.text' (6, 6, "stored") 



— Types: 

subtype acct_enum is integer range . . list_length_limit; 

type local_account is 
record 

AD : Account_Mgt_Ex . account_AD ; 

number: acct_enum; 

name: System_Def s.text (name_length_limit) ; 

stored: boolean; 
end record; 

type list is 

array (list_pointer_init . . list_pointer_init+list_length_limit-l) 
of local_account; 

end Acct_Types; 
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X-A.7.6 Account_Mgt jex Package Specification 

Common specification for active-only, non-transaction-oriented stored, transaction-oriented 
stored, and distributed account type managers. 

1 with Authority_List_Mgt, 

2 Incident_Defs, 

3 Long_Integer_Defs, 

4 Object_Mgt, 

5 System, 

6 System_Defs; 
7 

8 package Account_Mgt_Ex is 
9 

10 — Function: 

11 — Type manager for accounts. An account 

12 — contains a non-negative balance of type 

13 — "Long_Integer_Defs.long_integer" . 
14 

15 — Several aspects of accounts are 

16 — implementation-defined: 
17 

18 — 1. Whether accounts can be passivated. 
19 

20 — 2. What activation model is used for 

21 — accounts. 
22 

23 — 3. Whether account operations are 

24 — atomic, either succeeding completely 

25 — or failing completely. 
26 

27 — 4. Whether an account object can 

28 — simultaneously be used by multiple 

29 — processes within a single job. 
30 

31 — 5. Whether the account manager is 

32 — distributed, providing service at 

33 — at multiple nodes in a distributed 

34 — system, regardless of which nodes 

35 — accounts are stored at. 
36 

37 — 6. Some of the protection provided 

38 — between the account manager and other 

39 — services. 
40 

41 — 7. How and where the account TDO is defined 

42 — (so long as its lifetime is >= the lifetime 

43 — of any account) . 
44 

45 — 8. Account attributes. 

46 

47 — 9. Account manager initialization requirements. 

48 

49 — Calls: 

50 — Is_account - Checks whether an AD 

51 — references an account. 
52 

53 — Create_account - Creates an account 

54 — with an initial balance. 
55 

56 — Create_stored_account - Creates and stores an account. 
57 

58 — Get_balance - Returns an account's 

59 — balance. 
60 

61 — Change_balance - Changes an account's 

62 — balance. 
63 

64 — Transfer - Moves an amount between 

65 — accounts. 
66 

67 — Destroy_account - Destroys an account. 

68 

69 — Messages: 

70 

71 insufficient balance code: 
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constant Incident_Defs. incident_code := 

(0, 1, Incident_Defs. error, System. null_word) 

— *D* manage. messages 

— *D* store :module=0 snumber^l \ 

— *D* :msg_name=insuf ficient_balance_code \ 

— *D* :short= \ 

— *D* "An account operation failed because it\ 

— *D* would create a negative balance." 

balance_not_zero_code : 

constant Incident_Defs.incident_code := 

(0, 2, Incident_Defs. error, System. null_word) 

— *D* store :module=0 :number=2 \ 

~*D* :short= \ 

— *D* "An account cannot be destroyed because\ 

— *D* it has a non-zero balance." 

— *D* exit 

■— ■=■ Exceptions: 

insufficient_balance: exception; 

pragma exception_value (insuf f icient_balance, 
insuf ficient_balance_code' address) ; 

— An operation failed because it would 

— cause a negative account balance. 

balance_not_zero: exception; 

pragma exception_value (balance_not_zero, 
balance_not_zero_code' address) ; 

— "Destroy_account" was called on an account 

— with a nonzero balance. 



History: 

11-01-1985: 
04-04-1988: 



Martin L. Buchanan, Initial version. 
Tobias Haas 

Revised in order to unify all 

account manager examples. 



type account_object is limited private; 

type account_AD is access account_object; 
pragma access_kind(account_AD, AD); 
— User view of an account. 



change_rights: constant 

Object_Mgt.rights_mask :== 
Ob j ect_Mgt . modi f y_right s ; 

— Required to change an account's balance. 

destroy_rights: constant 

Object_Mgt. right s_mask := 
Object_Mgt .control_rights; 

— Required to destroy an account. 



function Is_account ( 

obj: System. untyped_word) — AD to check, 
return boolean; 

— true if "obj" references an account, 

— else false. 

pragma protect ed_return (Is_account) ; 

— Function: 

Checks whether "obj" references an 

— account. 



function Create_account ( 
starting_balance : 

Long_Integer_Defs.long_integer := 
Long Integer Defs.zero) 
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— Initial balance of the account, 
return account_AD; 

— New account with all type rights and no 

— rep rights. 

pragma protected_return (Create_account) ; 

— Function: 

Creates an account and returns an AD with all 
type rights. The caller is responsible for 
storing the AD and updating the object. 

"starting_balance" must be nonnegative. 

— Exceptions: 

insuf f icient_balance : 

A negative balance was supplied. 

Passive_Store_Mgt . no_master_AD : 

The object provided to store the AD in, has 
no master AD. 



function Create_stored_account ( 
starting_balance : 

Long_Integer_Def s. long_integer := 
Long_Integer_Def s . zero; 

— Initial balance of the account, 
master: System_Defs.text; 

— Text record that holds the pathname 

— for the master AD. 
authority: 

Authority_List_Mgt .authority_list_AD := 
null) 

— Optional authority list, 
return account_AD; 

— AD to the account with all type rights and no 

— rep rights. 

pragma protected_return (Create_stored_account) ; 

— Function: 

Creates a new account and stores the master AD 
under the pathname given by "master". 
Caller must have store rights for the named 

— directory. 

The pathname cannot already be in use. 
"starting^Jaalance" must be nonnegative. 

If "authority" is null, then the new account's 
authority list will be either (in that order) the 
containing directory's default authority list, if 
there is one, or the caller's default authority list, 
If none of these three is available, 
"Directory_Mgt .no_default_authority_list" will be 

— raised. 

— Exceptions: 

insuf ficient_balance : 

A negative starting balance was supplied. 

Di rect ory_Mgt . ent ry_exi st s : 

The pathname provided is already in use. 

Direcotry_Mgt . no_def ault_authority_list : 

No authority list was specified, the target 
directory has no default authority list and there 
is no default authority list in the caller's 

— process globals. 



function Get_balance ( 

account: account_AD) 
— Any account . 
return Long_Integer_Defs.long_integer; 

— Current balance, 
pragma protected_return (Get_balance) ; 

— Function: 
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226 — Returns an account's current balance. 

227 

228 

229 function Change_balance ( 

230 account: account_AD; 

231 — Account with change rights. 

232 amount: Long_Integer_Defs.long_integer) 

233 — Amount added to balance. 

234 return Long_Integer_Defs.long_integer; 

235 — New balance, equal to old balance 

236 — plus "amount". 

237 pragma protected_return(Change_balance) ; 
238 

239 — Function: 

240 — Adds "amount" to an account's balance 

241 — and returns the new balance. The new 

242 — balance cannot be negative. 
243 

244 — Exceptions: 

245 — insuf ficient_balance 
246 

247 

248 procedure Transfer ( 

24 9 source_account : account_AD; 

250 — Account with change rights. 

251 dest_account: account_AD; 

252 — Account with change rights. 

253 amount: Long_Integer_Def s. long_integer) ; 

254 — Amount transferred from source to 

255 — destination accounts; it can be 

256 — positive or negative. Cannot cause 

257 — a negative balance in either account. 

258 pragma protected_return (Transfer) ; 
259 

260 — Function: 

261 — Subtracts "amount" from "source_account" 

262 — and adds "amount" to "dest_account" . 
263 

264 — Exceptions: 

265 — insufficient_balance 
266 

267 

268 procedure Destroy_account ( 

269 account: account_AD) ; 

270 — Account with destroy rights. The 

271 — account's balance must be zero. 

272 pragma protected_return (Destroy_account) ; 
273 

274 — Function: 

275 — Destroys an account. 
276 

277 — The passive version, caller's active version, 

278 - — ■ and any master directory entry are destroyed. 
279 

280 — Notes: 

281 — Any subsequent "Get_balance" , 

282 — "Change_balance", or "Transfer" call 

283 — will raise "object_has_no_representation" 

284 — in the "System_Exceptions" package. 
285 

286 — Exceptions: 

287 — balance_not_zero 
288 

289 

290 pragma external; 

291 — Required if this package is used with the "virtual' 

292 — compilation model, which supports multiple domains 

293 — and multiple subsystems. 
294 

295 private 
296 

297 type account_object is 

298 — Empty dummy record. The real object 

299 — format is defined in the package body. 

300 record 

301 null; 

302 end record; 
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303 

304 end Account Mgt Ex; 
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X-A.7.7 Account_Mgt_Ex (Active Only) Package Body 

Active-only package implementation of the account type manager. 

1 with Access_Mgt, 

2 Attribute_Mgt, 

3 Long_Integer_Defs, 

4 Object_Mgt, 

5 Passive_Store_Mgt, 

6 System_Defs, 

7 System_Exceptions; 
8 

9 package body Account_Mgt_Ex is 
10 

11 — Logic: 

12 — This is an 'active-only' implementation of 

13 — the account manager, with these characteristics; 

14 — 1. Accounts cannot be passivated. 
15 

16 — 2. Account operations are atomic. 
17 

18 — 3. An account should not be concurrently 

19 — used by more than one process in a 

20 — single job. 
21 

22 — 4. Accounts and the account TDO are local 

23 — to the job that uses them. 
24 

25 — 5. The account TDO has the passive store 

26 — attribute. 
27 

28 — 6. Initialization of the account manager 

29 — is done within each job that uses it. 

30 — Initialization creates the account TDO 

31 — and assigns the passive store attribute 

32 — so that accounts are active-only. 
33 

34 

35 use Long_Integer_Def s; 

36 — Import "long_integer" operators. 
37 

38 type account_rep_ob ject is 

39 record 

40 balance: Long_Integer_Defs.long_integer; 

41 — Current balance. 

42 end record; 
43 

44 type account_rep_AD is access account_rep_ob ject; 

45 pragma access_kind(account_rep_AD, AD); 

46 — Private view of an account. 
47 

48 accountJTDO: constant Object_Mgt .TDO_AD := 

49 Object_Mgt.Create_TDO; 

50 — This declaration is elaborated each time 

51 — this package is initialized, that is, each 

52 — time a job using the package runs. This 

53 — technique for creating a TDO is only useful 

54 — for objects that are completely local to 

55 — a job and never stored or otherwise exported 

56 — outside the creating job. 
57 

58 

59 function Is_account ( 

60 obj: System. untyped_word) 

61 return boolean 
62 

63 — Logic: 

64 — If "obj" is not null, retrieve the object's 

65 — TDO and check whether it is the account TDO. 

66 is 

67 use Object_Mgt, System; 

68 — Import "=" for "Object_Mgt .TDO_AD" and 

69 — "System. untyped_word". 

70 begin 

71 return obj /= System. null_word and then 

72 Object_Mgt.Retrieve_TDO(obj) = account_TDO; 

73 end Is account; 
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function Create_account ( 
starting__balance : 

Long_Integer_Def s . long_integer : = 
Long_Integer_Def s. zero) 
return account_AD 

— Logic: 

— 1. Checks starting balance. 

— 2. Allocates an account. 

3. Initialize balance field, 

— 4. Remove rep rights on the returned AD. 
is 

account: account_AD; 

account_rep: account_rep_AD; 

FOR account_rep USE AT account' address; 

account_untyped: System. untyped_word; 

FOR account_untyped USE AT account' address; 

— One word viewed with three Ada types, 
begin 

if starting_balance < Long_Integer_Defs.zero then 

RAISE insufficient_balance; 

else 

account_untyped := Ob ject_Mgt .Allocate ( 
' size => Object_Mgt .object_size ( 

(account_rep_object' size + 31) /32), 

— Expression computes number of words 

— required to hold the number of bits 

— in an account, 
tdo => account_TDO) ; 

account_rep.all := account_rep_object' ( 
balance => starting_balance) ; 

account_untyped := Access_Mgt .Remove ( 

AD => account_untyped, 

rights => Object_Mgt.read_write_rights) ; 
RETURN account; 

end if; 
end Create account; 



function Create_stored_account ( 
starting_balance: 

Long_Integer_Def s . long_integer : = 
Long_Integer_Def s . zero; 
master: System_Def s.text; 
authority: 

Authority_List_Mgt .authority_list_AD := null) 
return account_AD 

— Logic: 

This call is not supported by this implementation. 

is 
begin 

RAISE System_Exceptions . operation_not_supported; 

RETURN null; 

end Create stored account; 



function Get_balance ( 

account: account_AD) 
return Long_Integer_Def s . long_integer 

— Logic: 

Amplifies read rights on "account" and 

returns the balance field, 
is 

account_rep: account_rep_AD; 

FOR account_rep USE AT account' address; 

account_untyped: System. untyped_word; 

FOR account untyped USE AT account' address; 
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begin 

account_untyped := Access_Mgt .Amplify ( 
AD => account_untyped, 
rights => Object_Mgt.read_rights, 
tdo => account_TDO) ; 
return account_rep. balance; 
end Get balance; 



function Change_balance{ 
account: account_AD; 

amount : Long_Integer_Def s . long_integer) 
return Long_Integer_Def s. long_integer 

— Logic: 

1. Imports rep rights on account if account 
has change rights. 

2. Adds "amount" to the existing balance to 
compute the prospective new balance. 

— "amount" can be positive (a deposit) , 

— negative (a withdrawal), or zero. 

— 3. If new balance would be negative, raises 

"insufficient_balance" and does not change 

— the balance. 

— 4. If new balance would be positive, then 

— stores the new balance and also returns it. 

— 5. Makes the update an atomic operation. If anything 

— goes wrong the update is rolled back, 
is 

account_rep: account_rep_AD; 

FOR account_rep USE AT account' address; 

account_untyped: System. untyped_word; 

FOR account_untyped USE AT account' address; 

new_balance: Long_Integer_Defs„long_integer; 

— Holds the new balance until a decision is 

— made whether to store it in the account. 
old_balance: Long_Integer_Defs.long_integer; 

— Holds the old balance in case the operation 

— has to be rolled back, 
begin 

account_untyped := Access_Mgt. Import ( 
AD => account_untyped, 
rights => change_rights, 
tdo => account_TDO) ; 

new_balance := account_rep. balance + amount; 

if new_balance < Long_Integer_Defs. zero then 
RAISE insuf ficient_balance; 

else 
begin 

old_balance := account_rep. balance; 
account_rep. balance := new_balance; 
RETURN new_balance; 
exception 

— An exception in this inner block means 

— that something has gone wrong with the 

— update. The old balance is restored, 
when others => 

account_rep. balance := old_balance; 
RAISE; 
end; 

end if; 
end Change_balance; 



procedure Transfer ( 
source_account : 
dest_^account : 
amount : 



account_AD; 
account_AD; 
Long Integer Defs.long integer) 



— Logic: 

1. Imports rep rights on both accounts if 
they have change rights. 

2. Compute the prospective new balances, 
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by subtracting "amount" from the source 

— account's balance and adding it to the 

— destination account's balance. 

— "amount" can be positive, negative, 
or zero. 

3. If either new balance would be negative, 

— raises "insufficient_balance" and does 

— not change the balance. 

— 4. Assigns the new balances. If an 

exception occurs between assigning the 

— new source balance and the. new destination 
balance, a handler rolls back the source 

— balance to its old value, preserving 
atomicity. 

is 

source_rep: account_rep_AD; 

FOR source_rep USE AT source_account' address; 

source_untyped: System. untyped_word; 

FOR source_untyped USE AT source_account' address; 

old_source_bal : Long_Integer_Def s. long_integer; 

— Used to remember the old source balance in case 

— it needs to be restored if an exception occurs. 
new_source_bal : Long_Integer_Def s . long_integer; 

— Holds the new source balance until a decision is 

— made whether to store it in the account. 

dest_rep: account_rep_AD; 

FOR dest_rep USE AT dest_account' address; 

dest_untyped: System. untyped_word; 

FOR dest_untyped USE AT dest_account' address; 

old_dest_bal : Long_Integer_Def s . long_integer; 

— Used to remember the old destination balance in case 

— it needs to be restored if an exception occurs. 
new_dest_bal : Long_Integer_Def s . long_integer; 

— Holds the new destination balance until a decision 

— is made whether to store it in the account. 

begin 

source_untyped := Access_Mgt. Import ( 

AD => source_untyped, 

rights => change_rights, 

tdo => account_TDO) ; 
dest_untyped := Access_Mgt .Import ( 

AD => dest_untyped, 

rights => change_rights, 

tdo => account_TDO) ; 

new_source_bal := source_rep. balance - amount; 
new_dest_bal := dest_rep. balance + amount; 

if new_source_bal < Long_Integer_Defs. zero 
or else 

new_dest_bal < Long_Integer_Defs.zero then 
RAISE insuf ficient_balance; 

else 

old_source_bal := source_rep. balance; 
old_dest__bal := dest_rep. balance; 

— Old balances are recorded here 

— in case the update will have to be 

— rolled back, 
begin 

source_rep. balance := new_source_bal; 
dest_rep. balance := new_dest_bal; 
exception 

— An exception in this inner block means 

— that something has gone wrong with 

— the update. Restore the old balances to make 

— this operation atomic, then 

— reraise the exception, 
when others => 

source__rep. balance := old_source_bal; 
dest_rep. balance := old_dest_bal; 
RAISE; 

end; 
RETURN; 
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305 

306 end if; 

307 end Transfer; 
308 

309 

310 procedure Destroy_account ( 

311 account: account_AD) 
312 

313 — Logic: 

314 — Imports rep rights on account if account 

315 — has destroy rights. 
316 

317 — If account's balance is not zero, raises 

318 — "balance_not_zero". 
319 

320 — Otherwise, destroys the account. 

321 is 

322 account_rep: account_rep_AD; 

323 FOR account_rep USE AT account' address; 

324 account untyped: System. untyped_word; 

325 FOR account_untyped USE AT account' address; 

326 begin 

327 account_untyped : = Access_Mgt .Import ( 

328 AD => account_untyped, 

329 rights => destroy_rights, 

330 tdo => accountJTDO) ; 
331 

332 if account_rep .'balance /= Long_Integer_Def s. zero then 

333 RAISE balance_not_zero; 
334 

335 else 

336 Ob ject_Mgt. Deallocate (account_untyped) ; 
337 

338 end if; 

339 end Destroy_account; 
340 

341 

342 begin 

343 declare 

344 passive__store_impl: constant 

345 Passive_Store_Mgt.PSM_attributes_AD := new 

346 Passive_Store_Mgt .PSM_attributes_ob ject; 

347 passive_store_impl_untyped: System. untyped_word; 

348 FOR passive_store_impl_untyped USE AT 

349 passive_store_impl' address; 

350 begin 

351 Passive_Store_Mgt . Set_refuse_f ilters ( 

352 passive_store_impl) ; 

353 Attribute_Mgt . Store_attribute_f or_type ( 

354 tdo => accountJTDO, 

355 attr_ID => Passive_Store_Mgt .PSM_attributes_ID, 

356 attr_impl => passive_store_impl_untyped) ; 

357 end; 

358 end Account Mgt Ex; 
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X-A.7.8 Account_Mgt_Ex (Stored, Non-transaction-oriented) Package Body 

Non-transaction-oriented implementation of the type manager for stored accounts. 

1 with Access_Mgt, 

2 Authority_List_Mgt, 

3 Directory_Mgt, 

4 Long_Integer_Defs, 

5 Object_Mgt, 

6 Passive_Store_Mgt, 

7 System, 

8 System_Defs; 
9 

10 package body Account_Mgt_Ex is 
11 

12 — Logic: 

13 — This is an implementation of the 

14 — account manager with these characteristics: 
15 

16 — * Operations are NOT guaranteed to be 

17 — transaction-oriented or atomic. 
18 

19 — * An account should NOT be concurrently 

20 — used, not by concurrent jobs and not by 

21 — concurrent processes in the same job. 
22 

23 — * The account TDO must already exist in 

24 — the distributed system's directory structure. 

25 — The "bind" pragma is used to bind to the 

26 ~ stored TDO. 
27 

28 — * The multiple activation model is used. 

29 

30 

31 use Long_Integer_Defs, — Import long integer 

32 — operators. 

33 System; — Import ordinal operators. 
34 

35 

36 type account_rep_ob ject is 

37 record 

38 balance: Long_Integer_Defs.long_integer; 

39 — Current balance. 

40 end record; 
41 

42 type account_rep_AD is access account_rep_object; 

43 pragma access_kind (account_rep_AD, AD); 

44 — Private view of an account. 
45 

46 

47 account_TDO: constant Ob ject_Mgt . TDO_AD := null; 

48 — This is a constant AD but not really null; its 

49 — filled in with an AD retrieved by the linker. 

50 pragma bind(account_TDO, 

51 "account") ; 

52 — Bind to TDO for accounts. 
53 

54 

55 function Is_account ( 

56 obj: System. untyped_word) 

57 return boolean 
58 

59 — Logic: 

60 — If "obj" is not null, retrieve the object's 

61 — TDO and check whether it is the account's TDO. 

62 is 

63 use Object_Mgt; — Import "=" for type "TDO_AD" . 

64 begin 

65 return obj /= System. null_word 

66 and then 

67 Object_Mgt.Retrieve_TDO(obj) = account_TDO; 

68 end Is_account; 
69 

70 

71 function Create_account ( 

72 starting_balance: 

73 Long_Integer_Defs.long_integer := 
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Long_Integer_Def s. zero) 
return account_AD 

— Logic: 

1. Check the initial balance. 

2. Allocate and initialize the account object. 

3. Remove rep rights for the exported AD. 
The caller is responsible for storing 
the AD and updating the object. 

4. Return the AD without rep rights, 
is 

account: account_AD; 

account_untyped: System. untyped_word; 

FOR account_untyped USE AT account' address; 

— Account with no rep rights, viewed with 

— either of two types. 

account_rep; account_rep_AD; 
account_rep_untyped: System. untyped_word; 
FOR account_rep_untyped USE AT 
account_rep' address; 

— Account with rep rights, viewed with 

— either of two types. 

begin 

— 1. Check the initial balance: 

if starting_balance < Long_Integer_Defs.zero then 
RAISE insufficient balance; 



else 



2. Allocate and initialize the account object: 



account_rep_untyped := Ob ject_Mgt .Allocate ( 

size => (account_rep_object' size + 31) /32, 
tdo => account_TDO) ; 

account_rep.all := account_rep_object' ( 
balance => starting_balance) ; 

— 3. Remove rep rights for the exported AD: 

account_untyped : = Aece ss_Mgt. Remove ( 
AD => account_rep_untyped, 
rights => Object_Mgt .read_write_rights) ; 

— 4. Return the account AD with no rep rights: 
RETURN account; 

end if; 
end Create account; 



function Create_stored_account ( 
starting_balance: 

Long_Integer_Defs.long_integer := 
Long_Integer_Def s . zero; 
master: System_Def s. text; 
authority: 

Authority_List_Mgt.authority_list_AD := null) 
return account_AD 

— Logic: 

— 1. Check the initial balance. 

— 2. Allocate and initialize the account object. 

3. Remove rep rights for the exported and master 

— AD . 

4. Store the master AD. 

Use "authority" as authority list to store the 
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account. If "authority" is null, the default 

— authority list of the target directory is used. 
If there is none the caller's authority list in 
the process globals is used. 

5. Passivate the account object itself. 

— 6. Return the AD without rep rights, 
is 

account: account_AD; 

account_untyped: System. untyped_word; 

FOR account_untyped USE AT account' address; 

— Account with no rep rights, viewed with 

— either of two types. 

account_rep: account_rep_AD; 
account_rep_untyped: System. untyped_word; 
FOR account_rep_untyped USE AT 
account_rep' address; 

— Account with rep rights, viewed with 

— either of two types. 

begin 

— 1. Check the initial balance: 

if starting_balance < Long_Integer_Defs.zero then 
RAISE insufficient_balance; 

else 

— 2. Allocate and initialize the account object: 

account_rep_untyped := Ob ject_Mgt. Allocate ( 

size => (account_rep_ob ject' size + 31) /32, 
tdo => account_TDO) ; 

account_rep.all := account_rep_object' ( 
balance => starting_balance) ; 

— 3. Remove rep rights for the exported and 

master AD: 

account_untyped := Access_Mgt .Remove ( 
AD => account_rep_untyped, 
rights => Ob ject_Mgt . read_write_rights) ; 

— 4. Store the master AD: 

Directory _Mgt . Store ( 
name => master, 
object => account_untyped, 
aut => authority) ; 

— 5. Passivate the account object itself: 
Passive_Store_Mgt .Update (account_rep_untyped) ; 

— 6. Return the account AD with no rep rights: 

RETURN account; 

end if; 
end Create stored account; 



function Get_balance( 

account: account_AD) 
return Long_Integer_Def s . long_integer 

— Logic: 

— 1. Amplify rep rights on the account AD. 

2. Return the balance, 
is 

account_rep: account_rep_AD; 

FOR account_rep USE AT account' address; 

account_untyped: System. untyped_word; 

FOR account untyped USE AT account' address; 
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begin 

account_untyped := Access_Mgt. Amplify ( 
AD => account_untyped, 
rights => Object_Mgt.read_write_rights, 
tdo => account_TDO) ; 

return account_rep. balance; 
end Get balance; 



function Change_ba lance ( 
account: account_AD; 

amount : Long_Integer_Def s . long_integer) 
return Long_Integer_Def s . long_integer 

— Logic: 

1. Import the account AD, checking for 
change rights and adding rep rights. 

2. If the new balance would be negative, 
then exit with an exception. 

3. Otherwise, change the balance, update 
the passive version, and return the 
new balance. 

is 

account_rep: account__rep = AD; 
FOR account_rep USE AT account' address; 
account_untyped: System. untyped_word; 
FOR account_untyped USE AT account' address; 
begin 

account_untyped := Access_Mgt .Import ( 
AD => account_untyped, 
rights => change_rights, 
tdo => account_TDO) ; 
if account_rep. balance + amount < zero then 
RAISE insuf ficient_balance; 

else 

account_rep. balance := 

account_rep. balance + amount; 
Passive_Store_Mgt .Update (account_untyped) ; 
RETURN account_rep. balance; 

end if; 
end Change balance; 



procedure Transfer ( 

source_account: account_AD; 
dest_account : account_AD; 
amount : Long_Integer_Def s . long_integer) 

— Logic: 

1. Import the account ADs, checking for 
change rights and adding rep rights. 

2. If either new balance would be negative, 

— then exit with an exception. 

3. Otherwise, change the balances, update 

— the passive versions, and return. 

— Warning: 

— This implementation is not atomic; a change 

— may be made in the source account but not 

— in the destination account if an exception, 

— system crash, or other error intervenes, 
is 

source_rep: account_rep_AD; 

FOR source_rep USE AT source_account' address; 

source_untyped: System. untyped_word; 

FOR source_untyped USE AT source_account' address; 

dest_rep: account_rep_AD; 

FOR dest_rep USE AT dest_account' address; 

dest_untyped: System. untyped_word; 



X-A-264 



Ada Examples 



r rvn.J-iXiYiAi'^rt.iv m. 



305 
306 
307 
308 
309 
310 
311 
312 
313 
314 
315 
316 
317 
318 
319 
320 
321 
322 
323 
324 
325 
326 
327 
328 
329 
330 
331 
332 
333 
334 
335 
336 
337 
338 
339 
340 
341 
342 
343 
344 
345 
346 
347 
348 
349 
350 
351 
352 
353 
354 
355 
356 
357 
358 
359 
360 
361 
362 
363 
364 
365 
366 
367 
368 
369 
370 
371 
372 
373 
374 
375 
376 
377 
378 
379 
380 
381 



FOR dest_untyped USE at dest_account' address; 
begin 

source_untyped := Access_Mgt .Import ( 

AD => source_untyped, 

rights => change_rights, 

tdo => account_TDO) ; 
dest_untyped := Access_Mgt. Import ( 

AD => dest_untyped, 

rights => change_rights, 

tdo => account_TDO) ; 

if source_rep. balance - amount < zero 
or else 

dest_rep. balance + amount < zero 
then 
RAISE insufficient_balance; 

else 

source_rep. balance := 

sour ce_rep. balance - amount; 
dest_rep. balance := 

dest_rep. balance + amount; 
Passive_Store_Mgt. Update (source_untyped) ; 
Passive_Store_Mgt . Update (dest_untyped) ; 
RETURN; 

end if; 
end Transfer; 



procedure Destroy_account { 
account: account_AD) 

— Logic: 

1. Import the account AD, checking for 
destroy rights and amplifying rep rights. 

2. Check that the account's balance is zero. 
If it isn't, raise an exception. If it 
is, execute the remaining steps. 

3. Destroy the account's passive version. 

4. Get the name of the account's master 
directory entry (if any) . Delete that 
directory entry. Note that other 
entries and even a master AD may remain 

— for the account. 

5. Deallocate the account's active version. 
is 

account_rep: account_rep_AD; 

FOR account__rep USE AT account' address; 

account_untyped: System. untyped_word; 

FOR account_untyped USE AT account' address; 

path__length: integer := 60; 

— Initial text length for name assigned 

— by "Directory _Mgt .Get_name". If 

— insufficient, then the value is 

— increased and the operation is 

— repeated, 
begin 

account_untyped := Access_Mgt . Import ( 
AD => account_untyped, 
rights => destroy_rights, 
tdo => account_TDO) ; 

if account_rep. balance /= 

Long_Integer_Defs. zero then 
RAISE balance_not_zero; 

else 

Passive_Store_Mgt. Destroy (account_untyped) ; 

loop 

declare 
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382 path_text: System_Defs.text (path_length) 

383 begin 

384 Directory_Mgt .Get_name ( 

385 obj => account_untyped, 

386 name => path_text); — out. 

387 if path_text . length > 

388 path_text . max_length then 

389 — Text was lost. Retry: 

390 path_length := path_text . length; 

391 else 

392 Directory_Mgt. Delete (path_text) ; 

393 EXIT; 
394 

395 end if; 

396 exception 

397 when Directory _Mgt.no_name => 

398 EXIT; 
399 

400 end; 

401 end loop; 
402 

403 Ob ject_Mgt . Deallocate (account_untyped) ; 

404 end if; 

405 end Destroy_account; 
406 

407 end Account_Mgt_Ex; 
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X-A.7.9 Account_MgtjEx (Stored, Transaction-oriented) Package Body 

Transaction-oriented implementation of the type manager for stored accounts. 

1 with Access_Mgt, 

2 Authority_List_Mgt, 

3 Directory_Mgt, 

4 Long_Integer_Defs, 

5 Object_Mgt, 

6 Passive_Store_Mgt, 

7 System, 

8 System_Defs, 

9 System_Exceptions, 
10 Transaction_Mgt; 
11 

12 package body Account_Mgt_Ex is 
13 

14 — Logic: 

15 — This is an implementation of the 

16 — account manager with these characteristics: 
17 

18 — * All operations are transaction-oriented, 

19 — participating in any default transaction 

20 — or else creating a transaction for the 

21 — duration of the operation. 
22 

23 — * An account should not be concurrently 

24 — used by more than one process in a single 

25 — job, unless an external locking protocol 

26 — is used. 
27 

28 — * The account TDO must already exist in 

29 — the distributed system's directory structure. 

30 — The. "bind" pragma is used to bind to the 

31 — stored TDO. 
32 

33 — * The multiple activation model is used. 

34 

35 

36 use Long_Integer_Def s, — Import "long_integer", "zero", 

37 — arithmetic and relational operators. 

38 System, — Import ordinal operators. 

39 Transaction_Mgt; — Import transaction calls. 
40 

41 

42 type account_rep_ob ject is 

43 record 

44 balance: Long_Integer_Defs.long_integer; 

45 — Current balance. 

46 end record; 
47 

48 type account_rep_AD is access account_rep_object; 

49 pragma access_kind (account_rep_AD, AD); 

50 — Private view of an account. 
51 

52 account_TDO: constant Object_Mgt.TDO_AD := null; 

53 — This is a constant AD but not really null; its 

54 — filled in with an AD retrieved by the linker. 

55 pragma bind(account_TDO, 

56 "account"); 

57 — Bind to TDO for accounts. 
58 

59 

60 function Is_account( 

61 obj: System. untyped_word) 

62 return boolean 
63 

64 — Logic: 

65 — If "obj" is not null, retrieve the object's 

66 — TDO and check whether it is the account's TDO. 

67 is 

68 use Object_Mgt; — Import "=" for type ,, TDO_AD" . 

69 begin 

70 return obj /= System. null_word 

71 and then 

72 Object_Mgt.Retrieve_TDO(obj) = account_TDO; 

73 end Is account; 
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function Create_account ( 
starting_balance : 

Long_Integer_Def s. long_integer := 
Long_Integer_Def s. zero) 
return account_AD 

— Logic: 

1. Check the initial balance. 

2. Allocate and initialize the account object. 

3. Return AD with no rep rights. 

4. If any exception occurs, abort any local 

— transaction, deallocate the account, 
and reraise the exception. 



account: account_AD; 

account_untyped: System. untyped_word; 

FOR account_untyped USE AT account' address; 

— Account with no rep rights, viewed with 

— either of two types. 

account_rep: account_rep_AD; 
account_rep_untyped: System. untyped_word; 
FOR account_rep_untyped USE AT 
account_rep' address; 

— Account with rep rights, viewed with 

— either of two types. 

begin 

— 1. Check the initial balance: 

if starting_balance < Long_Integer_Defs. zero then 
RAISE insufficient_balance; 

else 

— 2. Allocate and initialize the account object: 

account_rep_untyped := Ob ject_Mgt .Allocate ( 

size ==> (account_rep_object' size + 31) /32, 
tdo => account_TDO) ; 

begin 

— Inside this block it is guaranteed 

— that the object has been allocated. 
account_rep.all := account_rep_object' ( 

balance => starting_balance) ; 

— 3. Remove rep rights for the exported AD: 

account_untyped := Access_Mgt .Remove ( 
AD => account_rep_untyped, 
rights => Object_Mgt . read_write_rights) ; 

exception 

— 4. If any exception occurs, abort any local 

transaction, deallocate the account, 

— and reraise the exception: 

when others => 

Ob ject_Mgt. Deallocate (account_untyped) ; 
RAISE; 

end; 

RETURN account; 

end if; 
end Create_account; 

function Create__stored_account ( 
start ing_balance: 

Long_Integer_Def s . long_integer : = 
Long_Integer Defs.zero; 
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master: System_Defs.text; 
authority: 

Authority_List_Mgt.authority_list_AD := null) 
return account_AD 

— Logic: 

1. Check the initial balance. 

2. Allocate and initialize the account object. 

3. Remove rep rights for the. exported and 
master AD. 

4. Start a local transaction if there is 
not a transaction on the stack. 

5. Store the master AD. 

Use "authority" as authority list to store the 
account. If no authority list has be explicitly 
specified the default authority of the target 
directory is used. If there is none the the caller's 
authority list in the process globals is used instead. 

6. Passivate the account object itself. 

7. Commit any local transaction. 

— 8. If any exception occurs, abort any local 

transaction, deallocate the account, 

and reraise the exception, 
is 

account: account_AD; 

account_untyped: System. untyped_word; 

FOR account_untyped USE AT account' address; 

— Account with no rep rights, viewed with 

— either of two types. 

account_rep: account_rep_AD; 
account_rep_untyped: System. untyped_word; 
FOR account_rep_untyped USE AT 
account_rep' address; 

— Account with rep rights, viewed with 

— either of two types. 

trans: boolean := false; 

— True if a local transaction is started, 
begin 

— 1. Check the initial balance: 

if starting_balance < Long_Integer_Defs. zero then 
RAISE insuf ficient_balance; 

else 

-- 2. Allocate and initialize the account object: 

account_rep_untyped := Ob ject_Mgt .Allocate ( 

size => (account_rep_ob ject' size + 31) /32, 
tdo => account_TDO) ; 

account_rep.all := account_rep_object' ( 
balance => starting_balance) ; 

— 3. Remove rep rights for the exported and 

master AD: 

account_untyped := Access_Mgt .Remove ( 
AD => account_rep_untyped, 
rights => Ob ject_Mgt . read_write_rights) ; 

— 4. Start a local transaction if there is not 

a transaction on the stack: 

if Transaction_Mgt .Get_default_transaction = 
null then 

Transaction_Mgt . Start_transaction; 

trans := true; 
end if; 
begin 
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— 5. Store the master AD: 

Directory _Mgt . Store ( 
name => master, 
object => account_untyped, 
aut => authority) ; 

— 6. Passivate the account object itself: 
Passive_Store_Mgt .Update (account_rep_untyped) ; 

— 7. Commit any local transaction: 

if trans then 

Transaction_Mgt .Commit_transaction; 
end if; 
exception 

— 8. If any exception occurs, abort any local 

— transaction, deallocate the account, 
and reraise the exception: 

when others => 
if trans then 

Transact ion_Mgt.Abort_transact ion; 
end if; 

Ob ject_Mgt .Deallocate (account_untyped) ; 
RAISE; 

end; 

RETURN account; 

end if; 
end Create stored account; 



function Get_balance( 

account: account_AD) 

return Long_Integer_Def s . long_integer 

— Logic: 

1. Amplify rep rights on the account AD. 

2. Loop (in case of retry due to a transaction 
timestamp conflict) . 

3. If there is no default transaction, 
start a local transaction and flag that 
it is started. 

4. Reserve the account object to read-lock 
the passive version and ensure a clean 
and ^current* active version. 

5. Commit any local transaction, releasing 
the lock. 

6. Return the balance from the certainly 
clean active version. 

7. If there is a transaction timestamp 
conflict, and if a local transaction was 
started, then abort that transaction, loop 
back, start a fresh transaction, and try 
again. 

8. If there is any other exception, then 
abort any local transaction and reraise 
the exception. 

is 

account_rep: account_rep_AD; 

FOR account_rep USE AT account' address; 

account_untyped: System. untyped_word; 

FOR account_untyped USE AT account' address; 

trans: boolean := false; 

— True if a local transaction is started, 
begin 
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account_untyped := Acce ss_Mgt. Amplify ( 
AD => account_untyped, 
rights => Object_Mgt.read_write_rights, 
tdo => account_TDO) ; 

loop 

if Transaction_Mgt .Get_default_transaction = 
null then 
Transact ion_Mgt . Start_transaction; 
trans := true; 
end if; 
begin 

Passive_Store_Mgt .Reserve ( 
obj => account_untyped, 
read => true) ; 
if trans then 

Transaction_Mgt .Commit_transaction; 
end if; 
RETURN account_rep. balance; 

exception 

when System_Exceptions. 

transact ion_timestamp_conflict => 
if trans then 

Transaction_Mgt.Abort_transaction; 
else 
RAISE; 

end if; 
when others => 
if trans then 

Transact ion_Mgt .Abort_transaction; 
end if; 
RAISE; 

end; 

end loop; 
end Get balance; 



function Change_balance ( 
account: account_AD; 

amount : Long_Integer_Def s . long_integer) 
return Long_Integer_Defs. long_integer 

— Logic: 

1. Import the account AD, checking for 
change rights and adding rep rights. 

2. Loop (in case of retry due to a transaction 
timestamp conflict) . 

3. If there is no default transaction, then 

— start a local transaction and flag that it 
is started. 

4. Reserve the account object to write-lock 
the passive version and ensure a clean 
and *current* active version. 

5. If the new balance would be negative, abort 
the transaction and exit with an exception. 

6. Otherwise, change the balance, update the 
passive version, and commit any local 

— transaction, releasing the lock. 

— 7. If there is a transaction timestamp conflict, 

and if a local transaction was started, then 
abort that transaction, loop back, start a 
fresh transaction, and try again. 

— 8. If there is any other exception, then 

— abort any local transaction and reraise 

— the exception. 

— Notes: 
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— It might appear that instead of reserving the 

— object, the implementation could simply compute 

— the new balance, do the update, and reset the 

— active version and retry in the infrequent 

— case that "outdated_object_version" in 

— "Passive_Store_Mgt" is raised. However, such 

— an implementation would base the checking for 

— an insufficient balance on a possibly obsolete 
value, which is unacceptable. 

is 

account_rep : account_rep_AD ; 

FOR account_rep USE AT account' address; 

account_untyped : Sy st em. untyped_word; 

FOR account_untyped USE AT account' address; 

trans: boolean := false; 

— ■ True if a local transaction. is started, 
begin 

account_untyped := Access_Mgt .Import ( 
AD => account_untyped, 
rights => change_rights, 
tdo => account_TDO) ; 

loop 

if Transaction_Mgt.Get_default_transaction = 
null then 
Transaction_Mgt . Start_transaction; 
trans c .~ true; 
end if; 
begin 

Passive_Store_Mgt .Reserve (account_untyped) ; 
if account_rep. balance + amount < zero then 
RAISE insufficient_balance; 

else 

account_rep. balance := 

account_rep. balance + amount; 
Passive_Store_Mgt . Update (account_untyped) ; 
if trans then 

Transaction_Mgt . Commit_transaction; 
end if; 
RETURN account_rep. balance; 

end if; 
exception 

when System_Exceptions. 

transact ion_timestamp_conflict => 
if trans then 

Transact ion_Mgt.Abort_transact ion; 
else 
RAISE; 

end if; 
when others => 
if trans then 

Transact ion_Mgt.Abort_transact ion; 
end if; 
RAISE; 
end; 
end loop; 
end Change balance; 



procedure Transfer ( 

source_account : account_AD; 
dest_account: account_AD; 
amount : Long_Integer_Def s . long_integer) 

— Logic: 

1. Import the account ADs, checking for 
change rights and adding rep rights. 

2. Loop (in case of retry due to a transaction 
timestamp conflict) . 

3. If there is no default transaction, then 
start a local transaction and flag that it 
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is started. 

4. Reserve the account objects to write-lock 
the passive versions and ensure a clean 
and *current* active version. 

— 5. If either new balance would be negative, abort 

the transaction and exit with an exception. 

6. Otherwise, change the balances, update the 
passive versions, and commit any local 
transaction, releasing the lock. 

7. If there is a transaction timestamp conflict, 

— and if a local transaction was started, then 
abort that transaction, loop back, start a 
fresh transaction, and try again. 

8. If there is any other exception, then 
abort any local transaction and reraise 
the exception. 

is 

source_rep: account_rep_AD; 

FOR source_rep USE AT source_account' address; 

source_untyped: System. untyped_word; 

FOR source_untyped USE AT source_account' address; 

dest_rep: account_rep_AD; 

FOR dest_rep USE AT dest_account' address; 

dest_untyped: System. untyped_word; 

FOR dest_untyped USE at dest_account' address; 

trans: boolean := false; 

— True if a local transaction is started, 
begin 

source_untyped := Access_Mgt. Import ( 

AD => source_untyped, 

rights => change_rights, 

tdo => account_TDO) ; 
dest_untyped := Access_Mgt .Import { 

AD => dest_untyped, 

rights => change_rights, 

tdo => account_TDO) ; 

loop 

if Transaction_Mgt .Get_default_transaction = 
null then 
Transaction_Mgt . Start_transaction; 
trans := true; 
end if; 
begin 

Passive_Store_Mgt .Reserve (source_untyped) ; 
Passive_Store_Mgt .Reserve (dest_untyped) ; 
if source_rep. balance - amount < zero 
or else 

dest_rep. balance + amount < zero 
then 
RAISE insuf ficient_balance; 

else 

source_rep. balance := 

sour ce_rep. balance - amount; 
dest_rep. balance := 

dest_rep. balance + amount; 
Passive_Store_Mgt. Update (source_untyped) ; 
Passive_Store_Mgt . Update (dest_untyped) ; 
if trans then 

Transaction_Mgt .Commit_transaction; 
end if; 
RETURN; 

end if; 
exception 

when System_Exceptions. 

transact ion_timestamp_conflict => 
if trans then 
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Transact ion_Mgt.Abort_transact ion; 
else 

RAISE; 

end if; 
when others => 
if trans then 

Transact ion_Mgt.Abort_transact ion; 
end if; 
RAISE; 



end; 

end loop; 

end Transfer; 



procedure Destroy_account ( 
account: account_AD) 

— Logic: 

1. Import the account AD, checking for 
destroy rights and amplifying rep rights. 

2. Loop in case of retry due to timestamp 
conflict. 

3. If there is no default transaction, then 

— start a local transaction and flag that it 

— is started. 

4. Reserve the account object to write-lock 
the passive version and ensure a clean 
and current active version. 

5. Check that the account's balance is zero. 
If it isn't, raise an exception. The 
block's exception handler will abort 

any local transaction. 

6. Destroy the account's passive version. 

7. Get the name of the account's master 
directory entry (if any) . Delete that 
directory entry. Note that other 
entries and even a master AD may remain 
for the account . 

8. If there is a transaction timestamp 
conflict, and if a local transaction 

was started, then abort that transaction, 
loop back, start a fresh transaction, 
and try again. 

— 9. If any other exception occurs, abort 

any local transaction and reraise the 
exception. 

— 10. Deallocate the account's active version. 
is 

account_rep: account_rep_AD; 

FOR account_rep USE AT account' address; 

account_untyped: System. untyped_word; 

FOR account__untyped USE AT account' address; 

trans: boolean := false; 

— True if a local transaction is started. 
begin 

account_untyped := Access_Mgt. Import ( 
AD => account_un typed, 
rights => destroy_rights, 
tdo => account_TDO) ; 
loop 

if Transaction_Mgt .Get_default_transaction = 
null then 
Transaction_Mgt . Start_transaction; 
trans := true; 
end if; 
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613 declare 

614 path_length: integer := 60; 

615 — Initial text length for name assigned 

616 — by "Direct ory_Mgt.Get_name". If 

617 — insufficient, then the value is 

618 — increased and the operation is 

619 — repeated. 

620 begin 

621 Passive_Store_Mgt .Reserve (account_untyped) ; 

622 if account_rep. balance /= 

-623 Long_Integer_Defs. zero then 

624 RAISE balance_not_zero; 

625 

626 end if; 

627 Passive_Store_Mgt .Destroy (account_untyped) ; 
628 

629 loop 

630 declare 

631 path_text: System_Defs.text (path_length) 

632 begin 

633 Directory _Mgt . Get_name ( 

634 obj => account_untyped, 

635 name => path_text) ; — out. 

636 if path_text . length > 

637 path_text.max_length then 

638 — Text was lost. Retry: 

639 path_length := path_text. length; 

640 else 

641 Directory_Mgt .Delete (path_text) ; 

642 EXIT; 
643 

644 end if; 

645 exception 

646 when Directory _Mgt .no_name => 

647 EXIT; 
648 

649 end; 

650 end loop; 

651 exception 

652 when System_Exceptions. 

653 transaction_timestamp_conflict => 

654 if trans then 

655 Abort_transaction; 

656 else 

657 RAISE; 
658 

659 end if; 
660 

661 when others => 

662 if trans then 

663 Abort_transaction; 

664 end if; 

665 RAISE; 
666 

667 end; 

668 EXIT; 

669 end loop; 

670 Ob ject_Mgt .Deallocate (account_untyped) ; 

671 end Destroy_account; 
672 

673 

674 end Account_Mgt_Ex; 
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X-A.7.10 stored_Account_TDO__initjEx Procedure 

Initialization procedure for stored account type managers. 

1 with Account_Type_Name_Ex, — Example package. 

2 Attribute_Mgt, 

3 Authority_List_Mgt, 

4 Directory_Mgt, 

5 Identification_Mgt, 

6 Object_Mgt, 

7 Passive_Store_Mgt, 

8 Refuse_reset_active_version_Ex, — Example package 

9 System, 

10 System_Defs, 

11 System_Exceptions, 

12 Text_Mgt, 

13 Transact ion_Mgt, 

14 Type_Name_Attribute_Ex, — Example package. 

15 User_Mgt, 

16 Unchecked_conversion; 
17 

18 procedure Stored_Account_TDO_Init_Ex 
19 

20 — Logic: 

21 — Initialize TDO for accounts and place it in 

22 — the passive store for use by instances of 

23 — "Stored_Account_Mgt_Ex" at different nodes. 
24 

25 — The account TDO has the OS passive store 

26 — attribute and the (example) type name attribute. 
27 

28 — Resetting an account' s active version or 

29 — copying accounts are not allowed outside the 

30 — type manager. Other passive store requests 

31 — are allowed. 

32 — History: 

33 — ??-??-????: Martin Buchanan, Initial version. 

34 — 12-01-1987: Tobias Haas, Removed , Refuse_reset_active_version' 

35 — procedure and placed in separate package. 

36 — 04-20-1988: Tobias Haas, Added extractor comments, bstex*.ex 

37 — 05-06-1988: Tobias Haas, Modified extractor comments, bstex*.ex 

38 — 05-20-1988: Tobias Haas, Added handler for Directory_Mgt . 

39 — entry_exists 

40 is 

41 use Transaction_Mgt; 

42 — Import transaction operators. 
43 

44 account_name: constant string := 

45 "account"; 

46 — pathname of account tdo. 
47 

48 account_text : System_Defs . text (account_name' length) ; 

49 — Pathname is placed in this text before calling 

50 — "Directory _Mgt. Store" . 
51 

52 account_TDO: Ob ject_Mgt . TDO_AD; 

53 — TDO for accounts. 
54 

55 passive_store_impl: 

56 Passive_Store_Mgt.PSM_attributes_AD; 

57 — Implementation of passive store attribute 

58 — for accounts. 
5 9. 

60 type_name_impl : System. untyped_word; 

61 — Implementation of type name attribute 

62 — for accounts. 
63 

64 owner_only: User_Mgt .protection_set (1) ; 

65 — Protection set that includes only one ID, namely 

66 — the type manager's owner. 
67 

68 authority: Authority_List_Mgt.authority_list_AD; 

69 — Authority list that contains only one ID, namely 

70 — the type manager's owner. 
71 

72 trans: boolean := false; 

73 — Set if local transaction is started. 
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74 
75 

76 function Untyped_from_PSM_attributes is 

77 new Unchecked_conversion ( 

78 source => Passive_Store_Mgt.PSM_attributes_AD, 

79 target => System. untyped_word) ; 
80 

81 

82 function Untyped_from_TDO is 

83 new Unchecked_conversion ( 

84 source => Object_Mgt.TDO_AD, 

85 target => System. untyped_word) ; 
86 

87 

88 begin 

89 Text_Mgt.Set (account_text, account_name) ; 
90 

91 account_TDO := Ob ject_Mgt .Create_TDO; 
92 

93 . passive_store_impl := new 

94 Passive_Store_Mgt .PSM_attributes_object; 
95 

96 passive_store_impl . reset := 

97 Refuse_reset_active_version_Ex. 

98 Refuse_reset_active_version' subprogram_value; 
99 

100 passive_store_impl.copy_permitted := false; 
101 

102 Attribute_Mgt . Store_attribute_f or_type ( 

103 tdo => account_TDO, 

104 attr_ID => Passive_Store_Mgt .PSM_attributes_ID, 

105 attr_impl => Untyped_from_PSM_attributes ( 

106 passive_store_impl) ) ; 

107 type_name_impl := Account_Type_Name_Ex'package_value; 
108 

109 Attribute_Mgt .Store_attribute_for_type ( 

110 tdo => account_TDO, 

111 attr_ID => Type_Name_Attribute_Ex. 

112 Get_type_name_attr_ID, 

113 attr_impl => type_name_impl ) ; 
114 

115 owner_only. length := 1; 

116 owner_only. entries (1) .rights := User_Mgt .access_rights' ( 

117 true, true, true) ; 

118 owner_only. entries (1) .id := Identification_Mgt .Get_user_id; 
119 

120 authority := Authority_List_Mgt.Create_authority (owner_only) 
121 

122 if Transaction_Mgt.Get_default_transaction = 

123 null then 

124 Transaction_Mgt . Start_transaction; 

125 trans := true; 

126 end if; 
127 

128 begin 

129 Directory_Mgt. Store ( 

130 name => account_text, 

131 object => Untyped_from_TDO (accountJTDO) , 

132 aut => authority) ; 

133 Passive_Store_Mgt .Request_update ( 

134 Untyped_f romJTDO (account_TDO) ) ; 

135 Passive_Store_Mgt .Request_update ( 

136 Untyped_from_PSM_attributes( 

137 passive_store_impl) ) ; 

138 Passive_Store_Mgt .Request_update ( 
13 9 type_name_impl ) ; 

140 

141 if trans then 

142 Transaction_Mgt.Commit_transaction; 

143 end if; 

144 exception 

145 when Directory _Mgt.entry_exists => 

146 if trans then 

147 Transaction_Mgt . Abort_transaction; 

148 end if; 
149 

150 when others => 
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151 if trans then 

152 Transaction_Mgt . Abort_transaction; 

153 end if; 

154 RAISE; 
155 

15 6 end; 

157 

158 end Stored Account TDO Init Ex; 
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X-A.7.1 1 Account_Type_Name_Ex Package Specification 

Type name attribute implementation for stored account type managers. 

1 with System, 

2 Type_Name_Attribute_Ex; 
3 

4 package Account_Type_Name_Ex is 

5 pragma package_value (Type_Name_Attribute_Ex.Ops) ; 
6 

7 — Function: 

8 — Defines the type name attribute for accounts. 
9 

10 — A type that supports this attribute has a 

11 — printable name. For example, a directory 

12 — listing utility could use this attribute to 

13 — print the types of the objects in a 

14 — directory. 
15 

16 

17 function Ty pe_n ame ( 

18 obj: System. untyped_word) 

19 return string; 

20 — Name of the "account" object type. 
21 

22 — Function: 

23 — Returns the type name for account objects. 
24 

25 

26 pragma external; 

27 

28 end Account Type Name Ex; 
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X-A.7.12 Account_Type_Name__Ex Package Body 

Type name attribute implementation for stored account type managers. 

1 with System; 

2 

3 package body Account_Type_Name_Ex is 

4 

5 

6 function Type_name ( 

7 obj: System. untyped_word) 

8 return string 

9 is 

10 begin 

11 return "account"; 

12 end Type_name; 
13 

14 

15 end Account_Type_Name_Ex; 
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X-A.7.13 Type_Name_Attr_Ex Package Specification 

Type name attribute package type. 



1 with Attribute_Mgt, 

2 System; 
3 

4 package Type_Name_Attribute_Ex is 
5 

6 — Function: 

7 — Define an attribute that returns a type's name. 
8 

9 — A type that supports the *type name* attribute has a 

10 — printable name. For example, a directory listing utility 

11 — could use the attribute to print the types of the objects 

12 — in a directory. 
13 

14 function Get_type_name_attr_ID 

15 return Attribute_Mgt.attribute_ID_AD; 

16 — Type name attribute ID, with type rights. 
17 

18 — Function: 

19 — Returns the type name attribute's attribute ID. 
20 

21 
22 

23 package Ops is 

24 pragma package_type ("typnamattr" ) ; 
25 

26 — Function: 

27 — Provide "Type_name" attribute call. 
28 

29 

30 function Type_name { 

31 obj: System. untyped_word) 

32 — Any object that support's 

33 — the type name attribute. 

34 return string; — Name of the object's type. 

35 pragma interface (value, Type_name) ; 
36 

37 — Function: 

38 — Returns a printable name for an object's type. 
39 

40 

41 end Ops; 

42 

43 

44 

45 pragma external; 

46 

47 end Type Name Attribute Ex; 
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X-A.7.14 Type__Name_Attr_Ex Package Body 

Type name attribute package type. 



1 with Attribute_Mgt, 

2 System_Defs; 
3 

4 package body Type_Name_Attribute_Ex is 

5 

6 

7 type_name_attr_ID: constant 

8 Attribute_Mgt.attribute_ID_AD :- null; 

9 pragma bind(type_name_attr_ID, 

10 "typnamattr") ; 

11 — Attribute ID is retrieved at link time using the 

12 — specified pathname. Should have store rights. 
13 

14 

15 function Get_type_name_attr_ID 

16 return Attribute_Mgt .attribute_ID_AD 

17 is 

18 begin 

19 return type_name_attr_ID; 

20 end Get_type_name_attr_ID; 
21 

22 

23 package body Ops' is 

24 

25 — Logic: 

26 — Attribute packages have null bodies. 
27 

28 

29 end Ops; 

30 

31 

32 end Type Name Attribute Ex; 
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X-A.7.15 Type_Name_Attribute_Init_Ex Procedure 
Creates the type name attribute ID. 

1 with 

2 Attribute_Mgt, 

3 Conversion_Support_Ex, 

4 Directory _Mgt, 

5 Passive_Store_Mgt, 

6 System_Defs, 

7 Transaction_Mgt; 
8 

9 procedure Type_Name_Attribute_Init_Ex is 
10 

11 — Function: 

12 — o Create new attribute. 
13 

14 — o Store new attribute. If attribute already 

15 — exists, all changes are rolled back and the 

16 — procedure exists 
17 

18 — o Update new attribute. 
19 

20 — History: 

21 — 05-10-1988: Tobias Haas: Initial version. 
22 

23 typ_nam_attr_ID_AD: Attribute_Mgt .attribute_ID_AD; 

24 — New attribute. 
25 

26 begin 

27 Transaction_Mgt . Start_transaction; 

28 — Transaction ensures that both operations, Store and 
2 9 — Update, will take place together or not at all. 

30 begin 

31 typ_nam_attr_ID_AD := Attribute_Mgt.Create_attribute_ID ( 

32 type_specific => true) ; 

33 — Create new attribute. 
34 

35 Directory_Mgt . store ( 

36 name => System_Def s.text' (10, 10, "typnamattr") , 

37 object => Conversion_Support_Ex.Untyped_from_attribute_ID ( 

38 typ_nam_attr_ID_AD) ) ; 

39 — Store attribute. If attribute already exists, this 

40 — operation will cause the Directory_Mgt .entry_exists 

41 — exception to be raised. 
42 

43 Passive_Store_Mgt.Request_update (Conversion_Support_Ex. 

44 Untyped_from_attribute_ID (typ_nam_attr_ID_AD) ) 

45 Transaction_Mgt . Commit_transaction; 

4 6 — Commit transaction after successful completion of 

47 — both operations. 

48 

4 9 exception 

50 when Directory_Mgt .entry _exists => 

51 Transaction_Mgt . Abort__transaction; 

52 — If entry exits, roll back any changes. 
53 

54 when others => 

55 Transaction_Mgt . Abort_transaction; 

56 RAISE; 
57 

58 end; 

59 end Type Name Attribute Init Ex; 
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X-A.7.16 Refuse_Reset_Active — version__Ex Package Specification 

Type-specific implementation for stored accounts. 

1 with System, 

2 System_Exceptions, 

3 Passive_Store_Mgt; 
4 

5 package Refuse_reset_active_version_Ex is 
6 

7 procedure Refuse_reset_active_version { 

8 obj: System. untyped_word) ; 
9 

10 — Function: 

11 — Handles requests to reset an account's active 

12 — version by refusing such requests. 
13 

14 pragma external; 
15 

16 pragma subprogram_value ( 

17 Passive_Store_Mgt . 

18 Type_specific_reset_active_version, 

19 Refuse_reset_active_version) ; 
20 

21 end Refuse reset active version Ex; 
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X-A/7.17Refuse_Reset_Active_Version_Ex Package Body 

Type-specific implementation for stored accounts. 

1 with System, 

2 System_Exceptions, 

3 Passive_Store_Mgt; 
4 

5 package body Refuse_reset_active_version_Ex is 
6 

7 — History: 

8 — 12-01-87: Tobias Haas, initial version. 

9 — 04-20-87: Tobias Haas, added extractor comments bstex*.ex 
10 

11 procedure Refuse_reset_active_version ( 

12 obj: System. untyped_word) 

13 is 
14 

15 — Function: 

16 — Handles requests to reset an account's active 

17 — version by refusing such requests. 
18 

19 

20 begin 

21 

22 RAISE System_Exceptions.operation_not_supported; 

23 

24 end Refuse_reset_active_version; 

25 

26 end Refuse reset active version Ex; 
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X-A.7.1 8 Account_Mgt_Ex (Distributed) Package Body 

Package body of the distributed account manager. 

1 with 

2 Access_Mgt, 

3 Attribute_Mgt, 

4 Authority_List_Mgt, 

5 Directory_Mgt, 

6 Distr_Acct_Call_Stub_Ex, 

7 Long_Integer_Defs, 

8 Object_Mgt, 

9 Passive_Store_Mgt, 

1 Semaphore_Mgt , 

11 System, 

12 System_Defs, 

13 System_Exceptions, 

14 Transaction_Mgt; 
15 

16 package body Account_Mgt_Ex is 
17 

18 — Logic: 

19 — This is an implementation of the distributed 

20 — account manager. It follows the single activation 

21 — model. It has the following characteristics: 
22 

23 — * All operations on accounts are centralized in 

24 — one home job. The home job is created at the node 

25 — where the first call to this package is made. 
26 

27 — * Accounts can be stored anywhere on the system. 
28 

29 — * Initialization, (creating the TDO, the server, 

30 — the service, installing the server, and setting up 

31 — the homomorph template) happen when the package is 

32 — eleborated. 
33 

34 — * All synchronization is centralized in the 

35 — home job: Transactions are used to synchronize accross 

36 — job boundaries and semaphores to synchronize between 

37 — different processes inside one job. 
38 

39 — * This code is used in the home job and in all 

40 — other jobs. In the home job operations are 

41 — done directly. In all other jobs a call stub 

42 — package is called that issues RPCs 

43 — to the home job to perform the actual operation. 
44 

45 — * The following picture 

46 — illustrates the structure of the distributed 

47 — implementation. Boxes represent independent jobs 

48 — that may run on any node. The names in the boxes 

49 — are the names of the packages. 
50 

51 — + + + + 

52 — | Account_Mgt_Ex | | Account_Mgt_Ex I 
53—1 || | 

54 — | Distr_Acct_ | | Distr_Acct_ | 

55 — | Call_Stub | | Call_Stub I 

56 — + + + + 

57 — Application Application 

58 — Job Job 
59 

60 

61 — + + 

62 — I Distr_Acct_ | 

63 — I Server_Stub | 

64 — | | 

65 — | Account_Mgt_Ex I 

66 — + + 

67 — Server Job 

68 — (Home Job) 
69 

70 

71 — * ADs to the TDO and the account service are created 

72 — by an initialization routine called Distr_acct_init 

73 — and stored with pathnames. They are retrieved by the 
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74 — various models at link-time. 
75 

76 — Exceptions: 

77 — no_server_installed: 

78 — Server for accounts is not installed. 

79 ' — 

80 — History: 

81 — 01-31-88: Tobias Haas, Initial version. 

82 — 06-08-88: Tobias Haas, Design revision. 
83 

84 use Long_Integer_Defs, — Import "long_integer", "zero' 

85 — arithmetic, and relational 

86 — operators. 

87 System, — Import ordinal operators. 

88 Transaction_Mgt; — Import transaction calls. 
89 

90 

91 account_TDO: constant Object_Mgt .TDO_AD := null; 

92 pragma bind(account_TDO, "account"); 

93 — Constant AD to account TDO. Initially null. 

94 — Filled in at link-time. 
95 

96 type account_rep_object is 

97 — Representation of an account. 

98 record 

99 lock: Semaphore_Mgt . semaphore_AD; 

100 — Locking area 

101 is_homomorph: boolean; 

102 — If false identifies the object 

103 — as the active version; if true 

104 — as a homomorph. 

105 balance: Long_Integer_Def s.long_integer; 

106 — Starting balance. 

107 end record; 

108 FOR account_rep_object USE 

109 record AT mod 32; 

110 lock at range .. 31; 

111 is_homomorph at 4 range . . 7; 

112 balance at 8 range . . 63; 

113 end record; 

114 type account_rep_AD is access account_rep_object; 

115 pragma access_kind(account_rep_AD, AD); 

116 — Private view of an account. 
117 

118 
119 

120 

121 

122 — 

123 — IS_ACCOUNT 

124 — 

125 

12 6 

127 

128 function Is_account ( 

129 obj: System. untyped_word) 

130 return boolean 
131 

132 — Logic: 

133 — If "obj" is not null, retrieve the object's 

134 — TDO and check whether it is the account's TDO. 
135 

136 is 

137 use Object_Mgt; — Import "=" for type "TDO_AD". 

138 begin 

139 return obj /= System. null_word 

140 and then 

141 Object_Mgt.Retrieve_TDO(obj) = account_TDO; 

142 end Is_account; 
143 

144 

145 

146 — 

147 — CREATE_ACCOUNT 

148 ~ 

14 9 : 

150 
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function Create_account ( 
starting_balance : 

Long_Integer_Def s . long_integer : = 
Long_Integer_Def s. zero) 
return account_AD 

— Logic: 

Creates an account by allocating an object 
of type account. Storing the account is the 

— responsibility of the caller. Accounts can 

— be created in any account. 

— 1. Check initial balance. 

2. Allocate and initialize the account 

— object. 

3. Remove rep rights for the exported and 

— master AD. 

4. If any exception occurs, deallocate the object 
and return. 



account: account_AD; 

account_untyped: System. untyped_word; 

FOR account_untyped USE AT account' address; 

— Account with no rep rights, viewed with 

— either of two types. 

account_rep: account_rep_AD; 

account_rep_untyped: System. untyped_word; 
FOR account_rep_untyped use AT 
account_rep' address; 

— Account with rep rights, viewed with 

— either of two types. 

trans: boolean := false; 

— True if a local transaction has been 

— started, 
begin 

— 1. Check initial balance: 

if starting_balance < 

Long_Integer_Defs.zero then 
RAISE insuf ficient_balance; 

else 

— 2. Allocate and initialize the 

account object: 

account_rep_untyped := Ob ject_Mgt .Allocate ( 
size => (account_rep_ob ject' size+31) /32, 
tdo => account_TDO) ; 

begin 

account_rep.all := account_rep_object' ( 
lock => null, 
is_homomorph => false, 
balance => starting_balance) ; 

— 3. Remove rep rights for the exported and 

master AD: 

account_untyped := Access_Mgt .Remove ( 
AD => account_rep_untyped, 
rights => Object_Mgt . read_write_rights) ; 

exception 

— 4. If an exception occurs, deallocate the account 

and reraise the exception: 

when others => 

Ob ject_Mgt . Deallocate (account_untyped) ; 
RAISE; 
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228 end; 

229 RETURN account; 
230 

231 end if; 

232 

233 end Create_account; 

234 

235 

236 

237 — 

238 — CREATE_STORED_ACCOUNT 

239 -- 

240 

241 

242 

243 

244 function Create_stored_account ( 

245 starting_balance: 

246 Long_Integer_Def s.long_integer := 

247 Long_Integer_Defs.zero; 

248 master: System_Defs.text; 

249 authority: 

250 Authority_List_Mgt.authority_list_AD : = 

251 null) 

252 return account_AD 
253 

254 — Logic: 

255 — Any job can create accounts. In order to 

256 — ensure that no multiple active versions of 

257 — any account exist the active version is 

258 — deallocated as soon as it has been 

259 — passivated. Passivating the master AD 
2 60 — and deallocating the active version 
261 — are enclosed in a transaction. 

2 62 — These are the steps: 

263 

264 — 1. Check initial balance. 

265 

266 — 2. Allocate and initialize the account 

2 67 — object. 

268 

269 — 3. Remove rep rights for the exported and 

270 — master AD. 
271 

272 — 4. Start a local transaction if there is 

273 — not a transaction on the stack. 
274 

275 — 5. Create a master AD. Use "Store". This also 

276 — sets the object's authority list. 
277 

278 — 6. Passivate the account. 
279 

280 — 7. Deallocate the active version of the 

281 — account. 
282 

283 — 8. Commit any local transaction. 
284 

285 — 9. If an exception occurs, abort any local 

286 — transaction, deallocate the account 

287 — and reraise the exception. 
288 

289 is 

290 account: account_AD; 

291 account_untyped: System. untyped_word; 

292 FOR account_untyped USE AT account' address; 

293 — Account with no rep rights, viewed with 

294 — either of two types. 
295 

296 

297 account_rep: account_rep_AD; 

298 account_rep_untyped: System. untyped_word; 

299 FOR account_rep_untyped use AT 

300 account_rep' address; 

301 — Account with rep rights, viewed with 

302 — either of two types. 
303 

304 
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trans: boolean : = false; 

— True if a local transaction has been 

— started, 
begin 

— 1. Check initial balance: 

if starting_balance < 

Long_Integer_Def s . zero then 
RAISE insufficient_balance; 

else 

— 2. Allocate and initialize the 

account object: 

account_rep_untyped := Ob ject_Mgt .Allocate ( 
size => (account_rep_object' size+31) /32, 
tdo => account_TDO) ; 
account_rep.all := account_rep_object' ( 
lock => null, 

— Null because ' 'lock" is not present 
-~ in passive version. 
is_homomorph => false, 
balance => starting_balance) ; 



— 3. Remove rep rights for the exported and 
master AD: 

account_untyped := Access_Mgt .Remove ( 
AD => account_rep_untyped, 
rights => Object Mgt.read write_rights) ; 



— ■ 4. Start a local transaction if there is 
not one on the stack: 

if Transaction_Mgt .Get_default_transaction = 
null then 

Transaction_Mgt.Start_transaction; 

trans := true; 
end if; 



begin 

— This block controls the scope of 

— the exception handler. 

— 5. Create the master AD: 

Directory_Mgt . Store ( 
name => master, 
object => account_untyped, 
aut => authority) ; 

— 6. Passivate the representation of the account: 
Passive_Store_Mgt. Update (account_rep_untyped) ; 

— 7. Deallocate the active version of the 

— account : 

Ob ject_Mgt. Deallocate (account_rep_untyped) ; 

— 8. Commit any local transaction. 

if trans then 

Transaction_Mgt .Commit_transaction; 
end if; 

exception 

— 9. If an exception occurs, abort any local 

transaction, deallocate the account and 
reraise the exception: 

when others => 
if trans then 
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382 Transaction_Mgt . Abort_transaction; 

383 end if; 

384 Ob ject_Mgt. Deallocate (account_rep_untyped) ; 

385 RAISE; 
386 

387 end; 

388 RETURN account; 
389 

390 end if; 

391 end Create_stored_account; 
392 

3 93 

394 

395 

396 — 

397 -- GET_BALANCE 

398 — 

399 

400 

401 

402 function Get_balance ( 

403 account: account_AD) 

404 return Long_Integer_Defs. long_integer 
405 

406 — Logic: 

407 — 1. Amplify rep rights on the account AD. 
408 

409 — 2. If "is_homomorph" - is true: 

410 

411 — * Call the call stub. 

412 

413 — 3. If "is_homomorph" is false: 

414 

415 — * Start transaction if there is not 

416 — one on the stack. 
417 

418 — * Lock account with a semaphore. 

419 — (Deadlock is avoided by the 

420 — transaction timeout.) 
421 

422 — * Read current balance. 
423 

424 — * If an exeception occurs release the 

425 — account and abort any local transaction. 
426 

427 — * Release the object and commit any local 

428 — transaction. 
429 

430 is 

431 account_rep: account_rep_AD; 

432 — Account with rep rights. 
433 

434 account_rep_untyped: System. untyped_word; 

435 FOR account_rep_untyped USE AT account__rep' address; 

436 — untyped view of account with rep rights. 
437 

438 account_no_rep_untyped: System. untyped_word; 

439 FOR account_no_rep_untyped USE AT account' address; 

440 — Untyped view of account with no rep rights. 
441 

442 current_balance: Long_Integer_Defs.long_integer; 

443 — Current balance. 
444 

445 trans: boolean := false; 

446 — Is true if there is a local transaction. 
447 

448 begin 

449 account_rep_untyped := account_no_rep_untyped; 
450 

451 — 1. Amplify rep rights: 
452 

453 account_rep_untyped := Access_Mgt .Amplify ( 

454 AD => account_rep_untyped, 

455 rights => Object_Mgt .read_write_rights, 

456 tdo => account_tdo) ; 
457 

458 if account rep. is homomorph then 
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— 2. We have a homomorph: 

— Call the call stub: 

RETURN Distr_Acct_Call_Stub_Ex. 
Get_balance (account) ; 

else 

— 3. We are in the home job for accounts: 



-— Start a local transaction if there is not one 
— on the stack: 

if Transaction_Mgt.Get_default_transaction = null 
then 

Transaction_Mgt . Start_transaction; 

trans := true; 
end if; 

begin 

— iipn locks the account object. If another 

— process has already locked the object wait 

— until the object is released. Transaction 

— timeout prevents a deadlock. (A finite timeout 

— value has to be set at node initialization.) 

Semaphore_Mgt .P ( 

semaphore => account_rep. lock) ; 

begin 

— Read current balance: 

current_balance := account_rep. balance; 

— Release the account: 

Semaphore_Mgt . V ( 

semaphore => account_rep.lock) ; 

— Commit any local transaction: 

if trans then 

Transact ion_Mgt . Commit_transaction; 
end if; 

RETURN current_balance; 

exception 

— Release the object: 

when others => 

Semaphore_Mgt.V (semaphore => 
account_rep.lock) ; 
RAISE; 

end; 

exception 

— Abort any local transaction: 

when others => 
if trans then 

Transact ion_Mgt .Abort_transaction; 
end if; 
RAISE; 
end; 

end if; 

end Get balance; 
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CHANGE BALANCE 



function Change_balance ( 
account: account_AD; 

amount: Long_Integer_Def s.long_integer) 
return Long_Integer_Defs.long_integer 

— Logic: 

1. Check "account" for change rights and add rep 
rights. 

2. If "is_homomorph" is true make a remote call. 

3. If "is_homomorph" is false update the balance 
and return the new balance. 



account_rep: account_rep_AD; 

— Account with rep rights. 

account_rep_untyped: System. untyped_word; 

FOR account_rep_untyped USE AT account_rep' address; 

— untyped view of account with rep rights. 

account_no_rep_untyped: System. untyped_word; 

FOR account_no_rep_untyped USE AT account' address; 

— Untyped view of account with no rep rights. 

current_balance: Long_Integer_Def s.long_integer; 

— Current balance. 

trans: boolean := false; 

— Is true if there is a local transaction. 

begin 

account_rep_untyped := account_no_rep_untyped; 
account_rep_untyped := Access_Mgt . Import ( 

AD => account_rep_untyped, 

rights => change_rights, 

tdo => account_TDO) ; 

if account_rep. is_homomorph then 

RETURN Distr_Acct_Call_Stub_Ex.Change_balance { 
account => account, 
amount => amount ) ; 

else 

if Transaction_Mgt .Get_default_transaction = null 
then 
Transact ion_Mgt . Start_transaction; 
trans := true; 
end if; 

begin 

Semaphore_Mgt .P (account_rep. lock) ; 

begin 

if account_rep. balance + amount < zero then 
RAISE insuf ficient_balance; 

else 

account_rep. balance := account_rep. balance + 

amount ; 
Passive_Store_Mgt . Update (account_rep_untyped) 
Semaphore_Mgt . V ( account_rep . 1 ock ) ; 

if trans then 

Transaction_Mgt . Commit_transaction; 
end if; 
RETURN account_rep. balance; 

end if; 
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613 

614 exception 

615 when others => 

616 Semaphore_Mgt.V (semaphore => 

617 account_rep.lock) ; 

618 RAISE; 
619 

620 end; 

621 

622 exception 

623 

624 when others => 

625 if trans then 

626 Transaction_Mgt .Abort_transaction; 

627 end if; 

628 RAISE; 
629 

630 end; 

631 

632 end if; 

633 

634 end Change__balance; 

635 

636 

637 ■ 

638 — 

639 — TRANSFER 

640 — 

641 _____ _ 

642 

643 

644 procedure Transfer ( 

645 source_account : account_AD; 
64 6 dest_account : account_AD; 

647 amount: Long_Integer_Def s. long_integer) 

648 

649 — Logic: 

650 — 1. Check rights on both ADs and add rep rights. 
651 

652 — 2. If "is_homomorph" is true make a remote call. 

653 — If "is_homomorph" is false proceed with the 

654 — transfer. 
655 

656 — 3. If any of the resultant balances are negative 

657 — raise "insuf ficient_balance" . 
658 

659 is 

660 source_rep: account_rep_AD; 
661 

662 source_rep_untyped: System. untyped_word; 

663 FOR source_rep_untyped USE AT source_rep' address; 
664 

665 source_no_rep_untyped: System. untyped_word; 

666 FOR source_no_rep_untyped USE AT source_account' address; 
667 

668 dest_rep: account_rep_AD; 
669 

670 dest_rep_untyped: System. untyped_word; 

671 FOR dest_rep_untyped USE AT dest_rep' address; 
672 

673 dest_no_rep_untyped: System. untyped_word; 

674 FOR dest_no_rep_untyped USE AT dest_account' address; 
675 

676 trans: boolean := false; 
677 

678 begin 

679 source_rep_untyped := source_no_rep_untyped; 

680 source_rep_untyped := Access_Mgt. Import ( 

681 AD => source_rep_untyped, 

682 rights => change_rights, 

683 tdo => account_TDO) ; 
684 

685 dest_rep_untyped := dest_no_rep_untyped; 

686 dest_rep__untyped := Access_Mgt . Import ( 

687 AD => dest_rep_untyped, 

688 rights => change_rights, 

689 tdo => account TDO); 
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690 

691 if source_rep.is_homomorph then 

692 — Only one of the accounts has to be checked. 

693 Distr_Acct_Call_Stub_Ex. Transfer ( 

694 source_account => source_account, 

695 dest_account => dest_account, 

696 amount => amount); 

697 RETURN; 
698 

699 else 

700 if Transaction_Mgt.Get_default_transaction = 

701 null then 

702 Transaction_Mgt . Start_transaction; 

703 end if; 
704 

705 begin 

706 Semaphore_Mgt . P ( 

707 semaphore => source_rep.lock) ; 
708 

709 begin 

710 Semaphore_Mgt.P ( 

711 semaphore => dest_rep. lock) ; 
712 

713 begin 

714 if (source_rep. balance - amount < zero) 

715 or (dest_rep. balance - amount < zero) 

716 then 

717 RAISE insufficient_balance; 
718 

719 else 

720 source_rep. balance := 

721 source_rep. balance - amount; 

722 dest_rep. balance := 

723 dest__rep. balance - amount; 

724 Passive_Store_Mgt .Update (source_rep_untyped) 

725 Passive_Store_Mgt . Update (dest_rep_untyped) ; 

726 if trans then 

727 Transaction_Mgt.Commit_transaction; 

728 end if; 
729 

730 , end if; 

731 RETURN; 
732 

733 exception 

734 when others => 

735 Semaphore_Mgt.V( 

736 semaphore => dest_rep.lock) ; 

737 RAISE; 
738 

739 end; 

740 exception 

741 when others => 

742 Semaphore_Mgt.V( 

743 semaphore => source_rep. lock) ; 

744 RAISE; 
745 

74 6 end; 

747 exception 

748 when others => 

749 if trans then 

750 Transaction_Mgt . Abort_transaction; 

751 end if; 

752 RAISE; 
753 

754 end; 
755 

75 6 end if; 
757 

758 end Transfer; 
759 

760 

761 

762 — 

763 — DESTROY_ACCOUNT 

764 — 

765 

766 



Ada Examples 



X-A-295 



1*KJ&LJ]VJJ.INAKX 



767 

768 procedure Destroy_account ( 

769 account: account_AD) 
770 

771 — Logic: 

772 — 1. Check rights on "account". Add rep rights. 
773 

774 — 2. If "is_homomorph" is true make a remote call. 

775 

776 — 3. If "is_homomorph" is false proceed. 

777 

778 — 4. Start a local transaction if there is not one 

779 — on the stack. 
780 

781 — 5. lock the object with a semaphore 
782 

783 — 6. Check that the account balance is zero, 

784 — otherwise raise an exception. 
785 

786 — 7. Destroy the account's passive version. 
787 

788 — 8. Get the name of the object's master directory 

789 — entry, (if any) Remove that entry. Note that 

790 — other entries and even a master AD may remain. 
791 

792 — 9. If any exception occurs abort any local 

793 — transaction and reraise the exception. 
794 

795 — 10. Deallocate the account's active version. 
796 

797 is 

798 account_rep: account_rep_AD; 
799 

800 account_rep_untyped: System. untyped_word; 

801 FOR account_rep_untyped USE AT account_rep' address; 
802 

803 account_no_rep_untyped: System. untyped_word; 

804 FOR account_no_rep_untyped USE AT account' address; 
805 

806 trans: boolean := false; 
807 

808 begin 

809 account_rep_untyped := account_no_rep_untyped; 
810 

811 account_rep_untyped := Access_Mgt .Import ( 

812 AD => account_rep_untyped, 

813 rights => destroy_rights, 

814 tdo => account_TDO) ; 
815 

816 if account_rep. is_homomorph then 

817 Distr_Acct_Call_Stub_Ex.Destroy_account { 

818 account => account); 

819 RETURN; 
820 

821 else 

822 if Transact ion_Mgt.Get_default_transaction = 

823 null then 

824 Transaction_Mgt . Start_transaction; 

825 trans := true; 

826 end if; 
827 

828 begin 

829 Semaphore_Mgt . P ( 

830 semaphore => account_rep.lock) ; 
831 

832 declare 

833 path_length: integer := 60; 
834 

835 begin 

836 if account_rep. balance /= 

837 Long_Integer_Defs. zero then 

838 RAISE balance_not_zero; 
839 

840 end if; 

841 Passive_Store_Mgt. Destroy (account_rep_untyped) ; 
842 

843 loop 
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844 declare 

845 path_text: System_Defs.text (path_length) 
846 

847 begin 

848 Directory _Mgt. Get_name ( 

84 9 obj => account_rep_untyped, 

850 name => path_text) ; 

851 

852 if path_text . length > 

853 path_text.max_length then 

854 — text was lost. Try again. 

855 path_length := path_text. length; 
856 

857 else 

858 Directory _Mgt .Delete (path_text) ; 

859 EXIT; 
860 

861 end if; 

862 

863 exception 

864 when Directory_Mgt .no_name => 

865 EXIT; 
866 

867 end; 

868 

869 end loop; 

870 Semaphore_Mgt . Destroy_semaphore ( 

871 semaphore => account_rep. lock) ; 

872 Ob ject_Mgt. Deallocate (account_rep_untyped) ; 
873 

874 exception 

875 when others => 

876 S emaph o r e_Mgt . V ( 

877 semaphore => account_rep. lock) ; 

878 RAISE; 
879 

880 end; 

881 

882 exception 

883 when others => 

884 if trans then 

885 Transaction_Mgt .Abort_transaction; 

886 end if; 

887 RAISE; 
888 

889 end; 

890 

891 end if; 

892 

893 end Destroy_account; 

894 

895 end Account Mgt Ex; 
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X-A.7.1 9 Distr_Acct_Cali_stub_Ex Package Specification 

Call stub for the distributed account manager. Routes the type manager's requests. 



1 

2 

3 
4 
5 
6 
7 
8 
9 
10 
11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 
40 
41 
42 
43 
44 
45 
46 
47 
48 
49 
50 
51 
52 
53 
54 
55 
56 
57 
58 
59 
60 
61 
62 
63 
64 
65 
66 
67 
68 
69 
70 
71 
72 
73 



with 

Account_Mgt_Ex, 

Authority_List_Mgt, 

Long_Integer_Defs, 

Object_Mgt, 

System, 

System_Defs; 

package Distr_Acct_Call_Stub_Ex is 

— ■ Function: 

Call stub for distributed accounts 
type manager. Packs parameters into buffers and 
makes RPCs. Unpacks the results buffer 
and returns results to front end of type 
manager. "Is_account", "Create_account", 
"Create_stored_account" are always forwarded 
directly to the core and are therefore not 
needed in the call stub. 



Calls: 

Get_bal ance 

Change_bal ance 

Transfer 

Destroy account 



- Returns an account's 
balance. 

- Changes an account's 
balance. 

- Moves an amount between 
accounts. 

- Destroys an account. 



function Get_balance( 

account : Account_Mgt_Ex . account_AD ) 
return Long_Integer_Def s . long_integer; 
pragma protected return (Get balance) ; 



function Change_balance ( 

account : Account_Mgt_Ex . account_AD ; 

amount : Long_Integer_Def s. long_integer) 
return Long_Integer_Defs. long_integer; 
pragma protected_return (Change_balance) ; 



procedure Transfer ( 

sour ce_account : Account_Mgt_Ex . account_AD ; 
de st_account : Account_Mgt_Ex . account_AD ; 
amount: Long_Integer_Defs.long_integer) 

pragma protected_return (Transfer) ; 



procedure Destroy_account ( 

account : Account_Mgt_Ex . account_AD ) ; 
pragma protected_return (Destroy_account) ; 



pragma external; 

— Required if this package is used with the 

— "virtual" compilation model, which supports 

— multiple domains and multiple subsystems. 

private 

type account_object is 

— Empty dummy record. The object representation 

— is defined in the package body. 
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74 record 

75 null; 

76 end record; 
77 

78 pragma external; 

79 

80 end Distr Acct Call Stub Ex; 
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record AT mod 32; 










lock at 





range 


. 


. 31 


is homomorph at 


4 


range 


. 


. 7 


balance at 


8 


range 


. 


. 63 


end record; 
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X-A.7.20 Distr_Acct_Call_stub_Ex Package Body 

Call stub for the distributed account manager. Routes the type manager's requests. 

1 with 

2 Account_Mgt_Ex, 

3 Distr_Acct_Server_Stub_Ex, 

4 Job_Types, 

5 Long_Integer_Defs, 

6 Object_Mgt, 

7 RPC_Call_Support, 

8 RPC_Mgt, 

9 Semaphore_Mgt, 
10 System_Defs; 
11 

12 package body Distr_Acct_Call_Stub_Ex is 
13 

14 type account_rep_object is 

15 — Representation of an account. 

16 record 

17 lock: Semaphore_Mgt . semaphore_AD; 

18 — Locking area 

19 is_homomorph: boolean; 

20 — If false identifies the object 

21 — as the active version; if true 

22 — as a homomorph. 

23 balance: Long_Integer_Def s. long__integer; 

24 — Starting balance. 

25 end record; 
26 

27 FOR account_rep_object USE 
28 
29 
30 
31 
32 
33 

34 type account_rep_AD is access account_rep_object; 

35 pragma access_kind(account_rep_AD, AD); 

36 — Private view of an account. 
37 

38 service: constant RPC_Mgt .RPC_service_AD : = null; 

39 — Distributed account service. 

40 — This is a constant but not really null. Will 

41 — be filled in with an AD retrieved by the linker. 
42 

43 pragma bind (service, "account_service") ; 

44 — Bind to account service 
45 

46 
47 

48 

4 9 

50 — 

51 -- GET_BALANCE 

52 — 

53 

54 

55 

56 function Get_balance ( 

5 7 account : Account_Mgt_Ex . account_AD ) 
58 return Long_Integer_Def s. long_integer 
59 

60 — Logic: 

61 — Pack Parameters into buffer and make RPC. 

62 — "Get_balance" has ordinal value 1 
63 

64 is 

65 account_untyped: System. untyped_word; 

66 FOR account_untyped USE AT account' address; 

67 — untyped view of account 
68 

69 current_balance: Long_Integer_Def s.long_integer; 

70 — Current balance. 
71 

72 parameters, results: Distr_Acct_Server_Stub_Ex. buffer; 

73 — Buffers for parameters and results. 
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74 

75 length: System. ordinal; 

76 — Used in remote call to hold actual length of 

77 — results buffer. 
78 

79 begin 

80 — Pack parameter buffer: 
81 

82 parameters := Distr_Acct_Server_Stub_Ex. buffer' ( 

83 first_word => account_untyped, 

84 second_word => System. null_word, 

85 — irrelevant 

86 amount => Long_Integer_Defs. zero) ; 

87 — irrelevant 
88 

89 — Make the RPC: 
90 

91 length := RPC_Call_Support.Remote_call ( 

92 service => service, 

93 target_proc => 1, 

94 param_buf => parameters' address, 

95 param_length => parameters' size, 

96 ADs_present => true, 

97 results_buf => results' address, 

98 result s_length => results' size) ; 

99 — "length" is not used here. 
100 

101 current_balance := re suits. amount; 

102 RETURN current_balance; 
103 

104 end Get_balance; 
105 

106 

107 

108 — 

109 — CHANGE_BALANCE 

110 — 

111 

112 

113 

114 

115 function Change_balance ( 

116 account: Account_Mgt_Ex.account_AD; 

117 amount: Long_Integer_Defs.long_integer) 

118 return Long_Integer_Defs.long_integer 

119 is 

120 account_untyped: System. untyped_word; 

121 FOR account_untyped USE AT account' address; 

122 — untyped view of account. 
123 

124 parameters, results: Distr_Acct_Server_Stub_Ex. buffer; 

125 — Buffers for parameters and results. 
126 

127 length: System. ordinal; 

128 — Used in remote call to hold actual length of 

129 — results buffer. 
130 

131 begin 

132 parameters := Distr_Acct_Server_Stub_Ex. buffer' ( 

133 first_word => account_untyped, 

134 second_word => System. null_word, 

135 — irrelevant 

136 amount => amount); 
137 

138 length := RPC_Call_Support .Remote_call ( 

139 service => service, 

140 target_proc => 2, 

141 param_buf => parameters' address, 

142 param_length => parameters' size, 

143 ADs_present => true, 

144 results_buf => results' address, 

145 results_length => results' size) ; 
14 6 RETURN results. amount; 

147 

148 end Change_balance; 

149 

150 
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151 

152 — 

153 -- TRANSFER 

154 -- 

155 

156 

157 

158 procedure Transfer ( 

159 source_account : Account_Mgt_Ex.account_AD; 

160 dest_account : Account_Mgt_Ex.account_AD; 

161 amount: Long_Integer_Def s.long_integer) 

162 is 

163 source_untyped: System. untyped_word; 

164 FOR source_untyped USE AT source_account ' address; 
165 

166 dest_untyped: System. untyped_word; 

167 FOR dest_untyped USE AT dest_account' address; 
168 

169 length: System. ordinal; 

170 

171 parameters, results: Distr_Acct_Server_Stub_Ex. buffer; 

172 

173 begin 

174 parameters := Distr_Acct_Server_Stub_Ex. buffer' ( 

175 first_word => source_untyped, 

176 second_word => dest_untyped, 

177 amount => amount); 
178 

179 length := RPC_Call_Support.Remote_call ( 

180 service => service, 

181 target_proc => 3, 

182 param_buf => parameters' address, 

183 param_length => parameters' size, 

184 ADs_present => true, 

185 results_buf => results' address, 

186 result s_length => results' size) ; 

187 RETURN; 
188 

189 end Transfer; 
190 

191 

192 

193 ~ 

194 -- DESTROY_ACCOUNT 

195 — 

196 

197 

198 

199 procedure Destroy_account ( 

200 account: Account_Mgt_Ex. account_AD) 

201 is 

202 account_untyped: System. untyped_word; 

203 FOR account_untyped USE AT account' address; 



205 
206 
207 
208 
209 
210 
211 
212 
213 
214 
215 
216 
217 
218 
219 
220 
221 
222 
223 
224 
225 
226 
227 



parameters, results: Distr_Acct_Server_Stub_Ex. buffer; 

length: System. ordinal; 

begin 

parameters := Distr_Acct_Server_Stub_Ex. buffer' ( 
first_word => account_untyped, 
second_word -> System. null_word, 

— irrelevant. 

amount => Long_Integer_Defs. zero) ; 

— irrelevant. 

length := RPC_Call_Support .Remote_call ( 

service => service, 

target_proc => 4, 

param_buf => parameters' address, 

param_length => parameters' size, 

ADs_present => true, 

results_buf => results' address, 

results_length => results' size) ; 
RETURN; 

end Destroy account; 
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228 end Distr Acct Call Stub Ex; 
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X-A.7.21 Distr_Acct_Server_stub_Ex Package Specification 

Server stub for distributed account manager. Receives and forwards RPC's. 



1 with 

2 Long_Integer_Defs f 

3 System; 
4 

5 package Distr_Acct_Server_Stub_Ex 



9 
10 

11 
12 
13 
14 
15 
16 
17 
18 
19 
20 
21 
22 
23 
24 
25 
26 
27 
28 
29 
30 
31 
32 
33 
34 
35 
36 
37 
38 
39 
40 
41 
42 
43 
44 
45 
46 
47 
48 
49 
50 
51 
52 
53 
54 
55 
56 
57 
58 
59 
60 
61 
62 
63 
64 
65 
66 
67 
68 
69 
70 
71 
72 
73 






range 


. 


. 31 


4 


range 


. 


. 31 


8 


range 


. 


. 63 



— Function: 

This package contains the 

server stub procedure for distributed 

account services. 

— Corresponds to RPC_Mgt . server_stub. 



type buffer is 

— Buffer used for remote calls, 
record 

first_word: System. untyped_word; 

second_word: System. untyped_word; 

amount : Long_Integer_Def s . long_integer; 
end record; 



FOR buffer USE 

record AT mod 32; 
first_word at 
second_word at 
amount at 

end record; 



— Exceptions: 

System_Exceptions.operation_not_supported is raised when 
a target procedure outsice the range . . 4 is specified. 



procedure server_stub ( 

— Function: 

Depending on the value of "target_proc" , 
upacks the parameter buffer, makes the 
corresponding call to "Distr_SA_Account_Mgt_Ex", 
packs the results buffer, and returns. 

target_proc: System. short_ordinal; 

— The number of the procedure to be called. 

— Has to be in the range .. 4. The 

— assignments are as follows: 

0: Calls Passive_Store_Mgt . Set_home_job 
in order to initialize the server. 



Cal 1 s Account_Mgt_Ex . Get_balance . 
Calls Account_Mgt_Ex.Change_balance . 
Calls Account_Mgt_Ex. Transfer. 
Calls Account_Mgt_Ex.Destroy_account . 
System. ordinal; 



version: 

— Not used. 

param_buf: System. address; 

— Address of parameter buffer. 
param_length: System. ordinal; 

— length of parameter buffer. 
results_buf: System. address; 

— Address of results buffer. 
results_length: in out System. ordinal; 

— Length of results buffer. 
ADs_returned: out boolean) ; 

— Are any ADs returned. If false, speeds 

— up the call . 

pragma external; 



X-A-304 



Ada Examples 



fKEUMJLINAKY 



74 

75 end Distr Acct Server Stub Ex; 
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X-A.7.22 Distr_Acct_Server_st\ib_Ex Package Body 

Server stub for distributed account manager. Receives and forwards RPC's. 

1 with 

2 Account_Mgt_Ex, 

3 Long_Integer_Defs, 

4 Object_Mgt, 

5 Passive_Store_Mgt, 

6 System, 

7 System_Exceptions; 
8 

9 package body Distr_Acct_Server_Stub_Ex is 

10 — 

11 -- Function: 

12 — This package contains the server stub 

13 — procedure for the distributed account 

14 — service. 

15 — 

16 — History: 

17 -- 01-31=88: Tobias Haas, Initial version. 

18 — 04-07-88: Extensive Revision of design. 
19 

20 

21 procedure server_stub ( 

22 target_proc: System. short_ordinal; 

23 version: System. ordinal; 

24 param_buf: System. address; 

25 param_length: System. ordinal; 

26 results_buf: System. address; 

27 results_length: in out System. ordinal; 

28 ADs_returned: out boolean) 
29 

30 — Function: 

31 — Procedure called by the account server 

32 — that unpacks the parameter buffer and 

33 — makes the appropriate calls. 
34 

35 — Logic: 

3 6 — Depending on "target_proc" unpacks "param_buf" 
37 — makes the call and packs "results_buf" . 

38 

39 is 

40 account_TDO_untyped: System. untyped_word; 

41 accountJTDO: Ob ject_Mgt .TDO_AD; 

42 FOR account_TDO USE AT account_TDO_untyped' address; 
43 

44 account_one_untyped, account_two_untyped: 

45 System. untyped_word; 

4 6 account_one, account_two: 

4 7 Account_Mgt_Ex . account_AD ; 

48 FOR account_one USE AT account_one_untyped' address; 

49 FOR account_two USE AT account J:wo_untyped' address; 
50 

51 amount: Long_Integer_Def s. long_integer; 
52 

53 parameters, results: buffer; 

54 FOR parameters USE AT param_buf; 

55 FOR results USE AT results_buf; 
56 

57 

58 begin 

5 9 case target_proc is 

60 when => account_TDO_untyped := parameters. first_word; 

61 Passive_Store_Mgt . Set_home_job ( 

62 tdo => accountJTDO) ; 

63 ADs_returned := false; 
64 

65 when 1 => account_one_untyped := parameters. first_word; 

66 amount := 

67 Account_Mgt_Ex.Get_balance ( 

68 account => account_one) ; 

69 results := buffer' ( 

70 first_word => System. null_word, 

71 — irrelevant 

72 second_word => System. null_word, 

73 — irrelevant. 
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74 

75 

76 

77 

78 

79 

80 

81 

82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 

100 

101 

102 

103 

104 

105 

106 

107 

108 

109 

110 

111 

112 

113 

114 

115 

116 

117 

118 

119 

120 

121 

122 

123 

124 

125 



amount => amount) ; 
ADs_returned := false; 

when 2 => account_one_untyped := parameters. first_word; 
amount : = 

Account_Mgt_Ex.Change_balance ( 
account => 

account_one, 
amount => 

parameters . amount ) ; 
results := buffer' { 

first_word => System. null_word, 

— irrelevant. 
second_word => System. null_word, 

— irrelevant, 
amount => amount ) ; 

ADs_returned := false; 

when 3 => account_one_untyped := parameters. first_word; 
account_two_untyped := parameters. second_word; 
Account_Mgt_Ex. Transfer ( 

source_account => account_one, 
dest_account => account_two, 
amount => 

parameters . amount ) ; 
results : = buffer' ( 

first_word => System. null_word, 
second_word => System. null_word, 
amount => 

Long_Integer_Def s. zero) ; 

— irrelevant. 
ADs_returned := false; 

when 4 => account_one_untyped := parameters. first_word; 
Account_Mgt_Ex.Destroy_account ( 

account => account_one) ; 
results := buffer' ( 

— irrelevant. 

first_word => System. null_word, 
second_word => System. null_word, 
amount => 

Long_Integer_Def s. zero) ; 
ADs_returned := false; 
when others => 

RAISE System_Exceptions . operation_not_supported; 
end case; 

RETURN; 

end server_stub; 

end Distr Acct Server Stub Ex; 
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X-A.7.23 Distr_Acct_init Procedure 

Initializes the distributed account manager globally for a distributed system. 

1 with Account_Type_Name_Ex, — Example package. 

2 Attribute_Mgt, 

3 Authority_List_Mgt, 

4 Directory_Mgt, 

5 Job_Types, 

6 Identification_Mgt, 

7 Object_Mgt, 

8 Passive_Store_Mgt, 

9 Refuse_reset_active_version_Ex, — Example package 

10 RPC_Mgt, 

11 System, 

12 System_Defs, 

13 Transact ionJMgt, 

14 Type_Name_Attribute_Ex, — Example package. 

15 User_Mgt, 

16 Unchecked_conversion; 
17 

18 procedure Distr_acct_init 
19 

20 — Function: 

21 — Initialization procedure for distributed 

22 — account service. 

23 — o Creates TDO. 

24 — o Initializes and stores attributes. 

25 — o Creates the service. 

26 — o Creates and installs the the server. 

27 — o Stores and updates TDO, server, and service. 
28 

2 9 — Logic: 

30 — Private ADs are stored with pathnames and 

31 — protected by authority lists. They are retrieved 

32 — by the various modules that are part of the distributed 

33 — account service at link-time. 
34 

35 — History: 

36 — 06-02-88: Tobias Haas, Initial version. 
37 

38 is 

39 use Transaction_Mgt; 

40 — Import transaction operators. 
41 

42 — Pathnames: 
43 

44 account_name : constant System_Defs. text := 

45 System_Defs.text' (7, 7, "account"); 

4 6 — Pathname of account tdo. 
47 

48 service_name: constant System_Def s. text := 

49 System_Defs.text' (15, 15, "account_service") ; 

50 — Pathname of service AD. 
51 

52 server__name: constant System_Defs. text : = 

53 System_Defs.text' (14, 14, "account_server") ; 

54 — Pathname of server job AD. 
55 

56 — Private ADs: 

57 

58 account_TDO: constant Object_Mgt . TDO_AD := 

5 9 Object_Mgt.Create_TDO; 

60 — TDO for accounts. 

61 server: constant RPC_Mgt . RPC_server_AD := 

62 RPC_Mgt . Create_RPC_server; 

63 — Server for accounts. 
64 

65 server_job: Job_Types. job_AD; 

66 — Installed server job. 
67 

68 service: RPC_Mgt .RPC_service_AD; 

69 — Distributed service AD. 
70 

71 — Attribute-related stuff: 

72 

73 passive store impl: 
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at 
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• 7; 


at 


8 


range 


. 


. 31; 


at 


12 


range 
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. 31; 
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74 Passive_Store_Mgt.PSM_attributes_AD; 

75 — Implementation of passive store attribute 

76 — for accounts. 
77 

78 type_name_impl : System. untyped_word; 

79 — Implementation of type name attribute 

80 — for accounts. 
81 

82 owner_only: User_Mgt .protection_set (1) ; 

83 — Protection set that includes only one ID, namely 

84 — the type manager's owner. 
85 

86 authority: Authority_List_Mgt.authority_list_AD; 

87 — Authority list that contains only one ID, namely 

88 — the type manager's owner. 
89 

90 type template is 

91 record 

92 dummy_wordO: System. untyped_word; 

93 is_homomorph: boolean; 

94 dummy _wordl: System. untyped_word; 

95 dummy _word2: System. untyped_word; 

96 end record; 
97 

98 FOR template USE 

99 record AT mod 32; 

100 dummy _w o r d 

101 is_homomorph 

102 dummy _wo rdl 

103 dummy _w o r d2 

104 end record; 
105 

106 type homomorph_AD is access template; 

107 pragma access_kind(homomorph_AD, AD); 
108 

109 homomorph: homomorph_AD; 

110 

111 — Auxiliary Stuff: 

112 

113 trans: boolean := false; 

114 — Set if local transaction is started. 
115 

116 

117 function Untyped_from_PSM_attributes is 

118 new Unchecked_conversion ( 

119 source => Passive_Store_Mgt .PSM_attributes_AD, 

120 target => System. untyped_word) ; 
121 

122 

123 function Untyped_from_TDO is 

124 new Unchecked_conversion ( 

125 source => Object_Mgt .TDO_AD, 

126 target => System. untyped_word) ; 
127 

128 

129 function Untyped_from_service is 

130 new Unchecked_conversion ( 

131 source => RPC_Mgt.RPC_service_AD, 

132 target => System. untyped_word) ; 
133 

134 function Untyped_from_homomorph is 

135 new Unchecked_conversion ( 
13 6 source => homomorph_AD, 

137 target => System. untyped_word) ; 

138 

13 9 function Untyped_from_job_AD is 

140 new Unchecked_conversion ( 

141 source => Job_Types. job_AD, 

142 target => System. untyped_word) ; 
143 

144 begin 

145 — 1. Allocate new passive store attribute implementation: 
146 

147 passive_store_impl := new 

148 Passive_Store_Mgt.PSM_attributes_object; 

149 — 2. Allocate and initialize homomorph template: 
150 
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homomorph := new template' ( 

dummy_word0 => System. null_word, 
is_homomorph => true, 
dummy_wordl => System. null_word, 
dummy _word2 => System. null_word) ; 

— 3. Initialize passive store attribute implementation: 

passive_store_impl. homomorph := Untyped_from_homomorph (homomorph) 

passive_store_impl. reset := 

Refuse_reset_active_version_Ex. 

Refuse_reset_active_version' subprogram_value; 

passiv@_store_impl.copy_permitted := false; 

passive_store_impl.locking_area_start := 0; 
passive_store_impl.locking_area_end := 0; 

— Area in account where semaphore AD will be 

— stored when account is activated. 

— 4. Store passive store attribute implementation with type: 

Attribute_Mgt . Store_attribute_f or_type ( 
tdo => account_TDO, 

attr_ID => Passive_Store_Mgt.PSM_Attributes_ID, 
attr_impl => Untyped_from_PSM_attributes ( 
passive_store_impl) ) ; 

— Store PSM attribute. 

— 5. Initialize type name attribute implementation: 
type_name_impl := Account_Type_Name_Ex'package_value; 

-- 6. Store type name attribute implementation with type: 

Attribute_Mgt . Store_attribute_f or_type ( 
tdo => account_TDO, 
attr_ID => Type_Name_Attribute_Ex. 

Get_type_name_attr_ID, 
attr_impl => type_name_impl) ; 

server := RPC_Mgt .Create_RPC_server; 

— 7. Install server: 

server_job := RPC_Mgt.Install_RPC_server ( 
server => server) ; 

— 8. Create the service: 

service := RPC_Mgt .Create_RPC_service ( 
server => server) ; 



— 9. Create authority list to protect private ADs: 

owner_only. length := 1; 

owner_only. entries (1) .rights := User_Mgt .access_rights' ( 

true, true, true) ; 
owner_only. entries (1) .id := Identification_Mgt .Get_user_id; 

authority := Authority_List_Mgt .Create_authority (owner_only) ; 

— 10. Store and Update the TDO, attributes and service. 
Use transactions to protect these operations: 

if Transaction_Mgt .Get_default_transaction = 
null then 

Transaction_Mgt . Start_transaction; 

trans := true; 
end if; 

begin 

Directory_Mgt . Store ( 

name => account__name, 

object => Untyped_from_TDO(account_TDO) , 

aut => authority) ; 
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228 Di rectory_Mgt. Store ( 

229 name => service_name, 

230 object => Untyped_from_service (service) , 

231 aut => authority) ; 
232 

233 Directory _Mgt. Store ( 

234 name => server_name, 

235 object => Untyped_from_job_AD (server_job) 

236 aut => authority); 
237 

238 Passive_Store_Mgt.Request_update ( 

239 Untyped_f rom_TD0 (account_TDO) ) ; 

240 Passive_Store_Mgt.Request_update ( 

241 Untyped_from_PSM_at tributes ( 

242 passive_store_impl) ) ; 

243 Passive_Store_Mgt.Request_update { 

244 type_name_impl ) ; 

245 Passive_Store_Mgt.Request_update ( 

24 6 Untyped_from_homomorph (homomorph) ) ; 

247 

248 

249 if trans then 

250 Transaction_Mgt.Commit_transaction; 

251 end if; 

252 exception 

253 when Di rectory _Mgt. entry _exists => 

254 if trans then 

255 Transaction_Mgt . Abort_transaction; 

256 end if; 
257 

258 when others => 

259 if trans then 

260 Transaction_Mgt .Abort_transaction; 

261 end if; 

262 RAISE; 



263 

264 end; 

265 

266 end Distr acct init; 
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X-A.7.24 Distr_Acct_Home_JobjEx Procedure 
Sets the home job of the account service. 

1 with 

2 Distr_Acct_Server_Stub_Ex, 

3 Long_Integer_Defs, 

4 Passive_Store_Mgt, 

5 RPC_Call_Support, 

6 RPC_Mgt, 

7 System; 



10 procedure Distr_Acct_Home_Job_Ex is 
11 

12 parameters, results: Distr_Acct_Server_Stub_Ex. buffer; 

13 — Buffers for remote call. 
14 

15 length: System. ordinal; 

16 — Gives actual length of results buffer in remote call. 

17 — Not used here. 
18 

19 service: constant RPC_Mgt.RPC_service_AD := null; 

20 pragma bind(service, "account_service") ; 

21 — Account service. Retrieved at link-time. 
22 

23 account_TDO_untyped: constant System. untyped_word 

24 := System. null_word; 

25 pragma bind(account_TDO_untyped, "account"); 
26 

27 begin 

28 — Set up server as home job 

29 — by calling procedure ' '0'': 
30 

31 parameters := Distr_Acct_Server_Stub_Ex. buffer' ( 

32 first_word => account_TDO_untyped, 

33 — account TDO 

34 second_word => System. null_word, — Irrelevant. 

35 amount => Long__Integer_Defs. zero) ; 

36 — Irrelevant. 
37 

38 length := RPC_Call_Support .Remote_call { 

39 service => service, 

40 target_proc => 0, 

41 — Server will call Passive_Store_Mgt . Set_home__job. 

42 param_buf => parameters' address, 

43 param_length => parameters' size, 

44 ADs_present => true, 

45 results_buf => results' address, 

46 results_length => results' size) ; 
47 

48 end Distr Acct Home Job Ex; 
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X-A.7.25 Makefile 

Makefile for the the preceding account type manager programs. To use type: 

• make acct_active, or 

• make non_xo, or 

• make stored 

to create different executable versions of the account type manager. NOTE: The distributed 
type manager is not yet implemented. 

1 IDefinitions: 

2 lib = ada_library 

3 impl = stored.b 

4 messages = "(acct_mgt.s acct_vis.b acct_main. sb) " 
5 

6 spec_obj = $ (lib) /acct_types. s. ob j \ 

7 $ (lib) /conversion_support_ex.s.obj \ 

8 $ (lib) /account_mgt_ex. s.obj \ 

9 $ (lib) /acct_visual. s.obj 
10 

11 body_obj = $ (lib) /acct_visual .b.ob j \ 

12 $ (lib) /acct_main_loop.b. obj \ 

13 $ (lib) /account_mgt_ex.b. ob j 
14 

15 tdo_spec_obj = $ (lib) /type_name_attribute_ex. s. obj \ 

16 $ (lib) /account__type_name_ex. s. obj \ 

17 $ (lib) /refuse_reset_active_version_ex. s.obj 
18 

19 tdo_body_obj = $ (lib) /type_name_attribute_ex.b. ob j \ 

20 $ (lib) /account_type_name_ex. b.ob j \ 

21 $ (lib) /refuse_reset_active_version_ex.b.obj 
22 

23 acct_active: $(spec_obj) $(body_obj) acct_active_body 

24 link.ada acct_main_loop 

25 manage. program acct_main_loop $ (messages) 

26 -mv acct_main_loop acct_active 
27 

28 non_xo: $(spec_obj) $(body_obj) non_xo_body stored_account_tdo_init_ex 

29 stored_account_tdo_init_ex 

30 link.ada acct_main_loop 

31 manage. program acct_main_loop $ (messages) 

32 -mv acct_main_loop non_xo 
33 

34 stored: $(spec_obj) $(body_obj) stored_body stored_account_tdo_init_ex 

35 stored_account_tdo_init_ex 

36 link.ada acct_main_loop 

37 manage. program acct_main_loop $ (messages) 

38 -mv acct_main_loop stored 
39 

40 acct_active_body : $(spec_obj) acct_active.b, account_mgt_ex.b. obj 

41 -ada acct_active.b 
42 

43 non_xo_body: $(spec_obj) non_xo.b, account_mgt_ex.b.obj 

44 -ada non_xo.b 
45 

46 stored_body: $(spec_obj) stored.b, account_mgt_ex.b. ob j 

47 -ada stored.b 
48 

49 $ (lib) /acct_visual. b.ob j : $(spec_obj) \ 

50 acct_vis.b 

51 -ada acct_vis.b 
52 

53 $ (lib) /acct_main_loop. b.ob j: $(spec_obj) \ 

54 acct_main.sb 

55 -ada acct_main.sb 
56 

57 $ (lib) /acct_visual. s.obj : $ (lib) /acct_types. s. obj \ 

58 $ (lib) / account_mgt_ex . s.obj \ 

59 acct_vis.s 

60 -ada acct_vis.s 
61 

62 $ (lib) /acct_types. s.obj : $ (lib) /account mgt ex. s.obj \ 
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63 acct_types.s 

64 -ada acct_types.s 
65 

66 $ (lib) /account_mgt_ex.s.obj: acct_mgt.s 

67 pwd 

68 -ada acct_mgt.s 
69 

70 $ (lib) /conversion_support_ex.s.obj: conv.s 

71 -ada conv.s 
72 

73 stored_account_tdo_init_ex: $ (tdo_spec_obj) \ 

74 $ (tdo_body_obj) \ 

75 type_name_attribute_init__ex \ 

76 acct_tdo.sb 

77 —ada acct tdo.sb 

78 type_name_attribute_init_ex 

79 link. ada stored_account_tdo_init_ex 
80 

81 $ (lib) /refuse_reset_active_version_ex.b.obj: $ (tdo_spec_obj) 

82 -ada refuse_reset_av.b 
83 

84 $ (lib) /type_name_attribute_ex.b.obj: $ (tdo_spec_obj) 

85 -ada typnam.b 
86 

87 $ (lib) /account_type_name_ex.b.obj : $ (tdo_spec_obj) 

88 -ada actyna.b 
89 

90 $ (lib) /refuse_reset_active_version_ex. s.obj : refuse_reset_av. s 

91 -ada refuse_reset_av. s 
92 

93 $ (lib) /account_type_name_ex. s.obj : $ (lib) /type_name_attribute_ex. s. ob j \ 

94 actyna.s 

95 -ada actyna.s 
96 

97 $ (lib) /type_name_attribute_ex. s.obj: typnam.s 

98 -ada typnam.s 
99 

100 type_name_attribute_init_ex: typnamattr. sb 

101 -ada typnamattr. sb 

102 link. ada type_name attribute_init_ex 
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X-A.7.26 Named__copy^ex Procedure 



1 with Directory_Mgt, 

2 Passive_Store_Mgt, 

3 System, 

4 System_Defs, 

5 System_Exceptions, 

6 Transaction_Mgt; 
7 

8 procedure Named_copy_ex ( 

9 source: System_Defs. text; 

10 dest: System_Def s.text) 

11 is 
12 

13 — Function: 

14 — Copies object tree at source pathname to 

15 — destination pathname. The source tree is the 

16 — named source passive object and all passive 

17 — objects reachable from it via successive 

18 — master AD references. The destination pathname 

19 — must not already exist. 
20 

21 — "Named_copy_ex" is transaction-oriented. 
22 

23 — Exceptions: 

24 — Di rectory _Mgt . entry _exists 

25 — Directory_Mgt.name_too_long 

26 — Directory_Mgt.no_access 

27 — System_Exceptions.bad_parameter - 

28 — Both the calling process and the 

29 — destination directory have a 

30 — null authority list. 

31 — SystemJBxceptions. 

32 — transaction_could_not_be_committed 
33 

34 — Body: 

35 — If there is no default transaction, then a local 

36 — transaction is created and transaction timestamp 

37 — conflicts are handled locally. Any other 

38 — exception is handled by aborting any local 

39 — transaction and reraising the exception. 
40 

41 — The root object AD is retrieved, a copy stub 

42 — is created, the copy stub AD is stored under 

43 — the destination pathname, and "Copy" is called 

44 — to copy the tree. 
45 

46 source_AD: System. untyped_word; 

47 dest_AD: System. untyped_word; 

48 begin 

49 loop 

50 declare 

51 trans: boolean := false; 

52 — Set if local transaction is started. 

53 use Transact ion_Mgt; 

54 — Import "=" for "transaction_AD". 

55 begin 

56 if Transaction_Mgt .Get_default_transaction 

57 = null then 

58 Transaction_Mgt . Start_transaction; 

59 trans := true; 

60 end if; 
61 

62 source_AD := Directory _Mgt .Retrieve (source) ; 

63 dest_AD := Passive_Store_Mgt . 

64 Create_copy_stub (source_AD) ; 

65 Directory _Mgt. Store (name => dest, 

66 object => dest_AD) ; 

67 Passive_Store_Mgt .Copy (source_AD, dest_AD) ; 

68 if trans then 

69 Transaction_Mgt .Commit_transaction; 

70 end if; 

71 RETURN; 
72 

73 exception 

74 when System Exceptions. 
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75 transaction_timestamp_conflict => 

76 if trans then 

77 Transaction_Mgt . Abort_transaction; 

78 — Loop back and try again if 

79 — transaction started locally. 

80 else 

81 RAISE; 

82 — Reraise the exception if the 

83 — transaction was already on the 

84 — transaction stack. 

85 end if; 
86 

87 when others => 

88 if trans then 

89 Transact ion_Mgt .Abort_transaction; 

90 end if; 

91 — Abort the transaction if it was 

92 — started locally. 

93 RAISE; 

94 — Reraise exception that invoked handler. 
95 

96 end; 



97 end loop; 

98 

99 end Named_copy_ex; 
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X-A.7.27 01der_than_ex Function 

1 with Long_Integer_Defs, 

2 Passive_Store_Mgt, 

3 System, 

4 System_Exceptions; 
5 

6 function 01der_than_ex ( 

7 a: System. untyped_word; 

8 b: System. untyped_word) 

9 return boolean 
10 is 

11 

12 — Function: 



13 — Returns true if object "a"'s passive version is 

14 — older than object "b"'s passive version. 
15 

16 — Exceptions: 

17 — System_Exceptions.bad_parameter - 

18 — Either "a" or "b" does not have a passive 

19 — version. 
20 

21 use Long_Integer_Def s; 

22 — Import "<" for long integers. 
23 

24 a_info: Passive_Store_Mgt ,passive_object_info; 

25 b_info: Passive_Store_Mgt .passive_ob ject_info; 

26 begin 

27 a_info := Passive_Store_Mgt . 

28 Request_passive_object_info (a) ; 

29 b_info := Passive_Store_Mgt . 

30 Request_passive_object_info (b) ; 
31 

32 if not a_info. valid or else not b_info. valid then 

33 RAISE System_Exceptions.bad_parameter; 
34 

35 else 

36 RETURN a_info.write_time < b_info.write_time; 
37 

38 end if; 

39 end Older than ex; 
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This glossary defines important terms used in this manual. Some definitions apply to this 
manual and some apply to other parts of the BiiN™ system. 



AD (access descriptor) 

(1) A protected pointer to a system object. An AD identifies a particular object and includes 
rights that determine what operations are allowed on the object via the AD. An AD can also 
be null, referencing no object. (2) In Ada, one of the alternatives used by pragma 

ACCESS_KIND. 

abort 

Terminate a transaction unsuccessfully, reversing all changes associated with the trans- 
action. 

abstract data type 

A data type with an unspecified representation. An abstract data type is defined entirely by 
its supported operations. OS object types such as files and directories are abstract data 
types. 

access 

Read or modify an object or datum. 

access descriptor (AD) 
A protected pointer to a system object. An AD identifies a particular object and includes 
rights that determine what operations are allowed on the object via the AD. An AD can also 
be null, referencing no object. 

access method (AM) 
A distinct way to use a device, defined by a set of I/O operations (typically Open, Close, 
Read, and Write). There are four access methods: byte-stream I/O, record I/O, character 
display I/O, and graphics display I/O. Each method is defined by a separate BiiN™ Ada 
package. Each device (pipe, file, directory, and so forth) supported by an access method has 
a different subset of the total operations available for the access method. 

access rights 

Bits in an access descriptor (AD) that restrict the sets of operations you can perform to 
manipulate an object. Access rights consist of three type rights bits (typically mapped to 
use, modify, and control for a particular service) and two representation rights bits (read and 
write). Type rights can be thought of as permissions granted to a caller by a service's type 
manager. The permissions allow the caller to perform certain operations on the type 
manager's objects. The representation rights bits are used only by type managers to read 
from and write to the representation of a particular type of system object. 
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access type 

An Ada type consisting of pointers to values of a specified second type. Values of a par- 
ticular access type are represented by either ADs, virtual addresses, linear addresses, or heap 
offsets. The access_kind pragma is used to specify the representation of an access type. 
Each access type also includes the special value null, indicating a pointer to nothing. If an 
access type is represented with ADs then referenced values are represented by system ob- 
jects. 

action 

(1) A record that specifies an event to be signaled, a destination to which the event is 
signaled, and an optional two-word message to all receivers of the event. A valid destina- 
tion is a process, a job, or an event cluster. (2) In SMS, the user-defined command to be 
executed when a condition on a target is satisfied. The possible actions for an SMS event 
include sending a mail message to the subscriber, broadcasting a message, or executing a 
BiiN™ CL command script in a batch session. 



activation model 

A characteristic of an object type that specifies how objects of the type are activated. The 
multiple activation model activates an object in any job or node. The single activation 
model activates an object only in a particular home job (for local objects) or home node (for 
global objects); another job or node that attempts to activate the object instead activates a 
homomorph, a token object that stands in place of the actual object. 

activate 

To create an active version of a system object from its current passive version. Objects are 
activated automatically when there is no active version of an object and a program 
references the object's representation. Activating an object activates ADs in the object but 
does not activate referenced objects. 

active memory 

The virtual memory of a particular BiiN™ node, as distinct from the passive store of a 
distributed BiiN™ system. 

active AD 

An AD in active memory, represented by one memory word. 

active object 

A system object in active memory. 

active version 

An active object that has been activated from a passive version. An object can have multiple 
active versions, in different jobs or at different nodes. 

active-only object 

An object that does not and cannot have a passive version. An object's type determines 
whether or not it can be passivated. 

actual parameter 

Value or variable supplied as a parameter in a specific invocation of a call. 
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Ada 

A standard programming language for programming large-scale and real-time systems. 
BiiN™ Ada is a complete implementation of Ada as specified by ANSI/MIL-STD-1815A, 
22 January 1983. The BiiN™ Ada implementation adds implementation-defined pragmas 
and attributes as the standard allows. 

address 

A value that can be used to access a particular object or memory location. An address may 
be an AD, virtual address, linear address, or physical address. Physical addresses are only 
used by the hardware and inside the OS. 

address space 

A set of memory locations. Each location is an <address, value> tuple. Address spaces 
include object address spaces, virtual address spaces, linear address spaces, and physical 
address spaces. 

address translation 

The process of converting a linear address or virtual address to a physical address. Address 
translation may trigger paging or object activation to load needed information into physical 
memory. 

advisory parameter 

A parameter that advises a service but does not dictate its actions. A service may ignore an 
advisory parameter or substitute a different value. 

aggregate 

(1) An Ada composite value, of an array or record type, consisting of element values listed 
within parentheses. (2) In C, an array, structure, or union. 

age factor 

The rate at which a waiting job ages in the scheduler's waiting queue (regardless of priority 
or service level). On every scan of the waiting queue, the age factor is added to the job's 
age to determine a new age. The larger the aging factor, the faster a job ages, and the sooner 
it rises to the front of the waiting queue. 

alias 
(1) In general, an entity that stands for another entity. (2) In the BiiN™ OS, a non-master 
passive AD. (3) In BiiN™ C, an identifier that is defined with the #pragma alias 
preprocessor control and is used to associate an identifier with its external definition. This 
type of alias is needed to refer to functions or data implemented in other languages with 
different forms for identifiers. (4) In the BiiN™ Systems Object Module Format, a two-byte 
number used as an abbreviation for a symbolic name in a single object module. (5) In 
CLEX, a short command that stands for a longer command. 

alias AD 
A passive AD that is not a master AD. An alias AD can refer to an object stored on a 
different volume set than the AD itself. 

amplify 

Add rights to an AD to some object. Amplifying rights is a privileged operation, requiring 
an AD to the object's TDO, with amplify rights. 
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amplify rights 

A type right for TDOs, required to amplify rights on ADs. 

argument 

(1) Values specified as part of a command. Arguments are defined with the 
manage . commands utility. An argument may be mandatory or optional. An argument 
has a name (prefixed by a colon: : argument_name), a type (one of: boolean, integer, 
pointer, range, string, string list, or derived), and a value ( [=some_value]). Optional ar- 
guments may have a default value. Arguments may be entered in named ox positional 
notation. (2) An expression that appears within the parentheses of a subprogram call. The 
expression is evaluated and the result is copied into the corresponding parameter of the 
called function. 

array type 

A structured data type consisting of a fixed number of components or elements, which are 
all of the same type. 

ASCII (American Standard Code for Information Interchange) 

A standard seven-bit code representing alphabetic, numeric, punctuation, mathematical, and 
control characters. 

atomic operation 

An operation that always succeeds completely or fails completely. An atomic operation 
never produces partial output or partial changes in its environment before failing. An atomic 
operation may also acquire locks to ensure that intermediate results are not visible to concur- 
rent operations. 

attribute 

(1) A property that can be associated with multiple system objects or object types. (2) A 
language-defined characteristic of a named Ada entity, such as ' size or ' imageo Some 
Ada attributes are functions. 

attribute call 

A subprogram invocation where the module implementation used is selected at invocation- 
time, based on the object type of the invocation's first actual parameter. 

attribute entry 

An <attribute ID, attribute value> tuple that gives an attribute's value for a particular system 
object or object type. 

attribute ID 

A system object that identifies an attribute. 

attribute instance 

An attribute value stored in a particular TDO. 

attribute list 

A system object that contains a list of object-specific attribute entries, for a particular object. 

attribute package 

A package that has different implementations for different system object types or system 
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objects. For example, Byte_Stream_AM . Ops is an attribute package. An attribute pack- 
age can only contain subprograms. 

authority list 

List of IDs and associated type rights. An authority list is associated with an object, and a 
caller must hold an ID that matches one in the authority list, with the appropriate rights, 
before the caller can access that object. 



backup service 

The OS service that manages backup and restore operations. 

base priority 

The lowest priority a process can have. It is determined initially by the SSO priority of its 
job (for a job's initial process) or by the base priority of its parent (for a spawned process). 
It may be changed by the user or the system administrator. 

basic disk 

A device that supports low-level access to a disk as an array of sectors or bytes via record 
I/O or byte stream I/O. 

basic I/O service 

The OS service that manages byte stream I/O, standard Ada I/O, and common I/O defini- 
tions. 

basic streamer 

A device that supports low-level access to a streamer tape via record I/O and byte stream 
VO. 

batch job 

A job that consists of a batch of requests ( a background job with no attached user). Like 
interactive jobs, batch jobs run in normal memory, have limited processor claim, and have a 
lower priority than real-time and time-critical jobs. 

bi-paged object 

An object representation in which the object is so large that its page table must also be 
paged. A bi-paged object's size ranges from 8M bytes to 4G bytes. 

body 

A BiiN Ada program unit containing the declarations and statements that implement a 
package, subprogram, or task specification. 

byte stream I/O 

An I/O access method that provides data transfer as an uninterpreted stream of bytes. Some 
implementations support random access to particular byte positions in the stream. 

blocked 

State of a process that is unable to execute because it is waiting on an event, a port, or a 
semaphore. 
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Boolean 

(1) Either true or false. (2) In BiiN™ Pascal, a predefined type. 



built-in commands 

Commands built i 

CLEX or to a program are executed by the command service itself. 



Commands built into BiiN™ CL, part of all command sets. Built-in commands entered to 



byte 

A unit of memory containing eight bits and aligned at an 8-bit boundary. Each byte has a 
distinct address, whether linear, virtual, or physical addresses are used. Bits in a byte are 
numbered from to 7. 



call 

(1) A subprogram. (2) A particular invocation of a subprogram. (3) To invoke a sub- 
program. 



T TM 



central system 

Central part of a BiiN'" 9 node, containing one or more P7 GDPs, one or more system buses, 
and shared memory. 

Channel Processor (CP) 
A P7 component that handles I/O transfers between a BiiN™ node's central system and I/O 
subsystems. The CP is the main hardware component of an I/O module. 

character display I/O 

An interactive access method that provides operations on character display terminals. 
Character display I/O is defined by the Character_Display_AM package. Character 
display I/O can also be used for output to printers. 

character display device 

A device that displays and manipulates ASCII characters on a two-dimensional surface. 
Typical examples are printers and windows on terminal screens; typical operations on such 
devices include input, output, cursor movement, manipulation of the display surface, control 
and status activities, and identifying and changing the attributes associated with a device. 

character terminal 

A terminal that has some subset of the features specified in the ANSI X3. 64 standard; for 
example, character insertion and deletion, line insertion and deletion, cursor positioning, and 
scrolling. The DEC VT-100 (a trademark of Digital Equipment Corp.) is a typical character 
terminal. 

character terminal manager 

A device manager that supports access to character terminals. 

character terminal user agent 

Software that allows a user to control the windows on a character terminal. It is provided by 
the character terminal manager. 

child process 

A process that is created (spawned) by another process (called the parent process). 
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The BiiN command language, used for invoking and controlling the execution of programs 
and scripts. CL is implemented by the command service. 

Clearinghouse 

A BiiN™ database that keeps track of where objects and IDs are within an entire distributed 
system. While objects and IDs are actually stored on physical nodes, the Clearinghouse 
keeps track of which node houses which objects and IDs. 

clearinghouse service 

The OS service that provides packages to manage the Clearinghouse to store names and 
node addresses across a distributed system. 

CLEX (Command Language Executive) 
The BiiN™ command interpreter of BiiN™ CL commands. CLEX is used for invoking and 
controlling the execution of programs and BiiN CL scripts. 

cluster 

Group of I/O queues that are serviced together. A cluster represents a group of devices, 
typically those serviced by the same CP task. 

clustered Hie 

A structured file whose records are organized in related groups ("clusters") according to a 
clustering b-tree organization index. 

command 

(1) A directive to a program (including CLEX itself) or script. A command consists of a 
command name followed by command arguments or control options. An invocation 
command is given to CLEX to invoke a program or BiiN™ CL script. Runtime commands 
are entered to control the operation of a program or BiiN™ CL script. Built-in commands are 
part of the command language (BiiN™ CL) itself. Commands are processed either by CLEX 
{CLEX commands and invocation commands), or by the Command Handler {built-in 
commands and runtime commands). (2) In mass storage I/O modules, a command defines 
the operation to be performed by the I/O Module. 

command history 

A record of all entered commands. There are several built-in commands provided by the 
command service to create, list, and re-execute a command history (a history log file). 
There is also a control option, : : history, which creates a history log file for the given 
command. 

command name 

A sequence of characters, such as create . alias, that identifies a BiiN™ CL command. 
The command name is the first part of a complete command. There may be two parts in a 
command name, the verb (create) and the noun (alias), separated by a period. Com- 
mand names may be shortened to the minimum unique abbreviation (c . al). 

command script 

A file containing a sequence of BiiN™ CL commands that are interpreted by CLEX. A 
command script differs from a command file in two important ways: (1) You can pass 
arguments to a command script, but not to a command file. (2) The command script is 
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interpreted as a separate job, whereas a command file is executed in the program's environ- 
ment 

command service 

The service that parses and returns commands for programs (including CLEX itself) and 
BiiN™ GL scripts. Built-in commands are processed by the command service itself. 

command set 

A command set defines the runtime commands currently available. A program using the 
command service always has at least one command set All command sets include the 
BiiN™ CL built-in commands. 

commit 

Complete a transaction successfully. If the transaction is not contained in some other trans- 
action, then any changes associated with the transaction are made permanent 

compaction 

A memory management daemon that relocates system objects and other memory segments 
to reduce fragmentation of normal memory. Compaction is transparent to application 
software. 

compilation unit 

(1) In general, a building block of a program or subsystem that, when compiled, produces a 
single object module. (2) When using the BiiN™ Application Debugger, a single unit of 

TM 

compilation, defined differently for each BiiN language and corresponding to a single 
object module. Referred to as a CU. (3) In BiiN™ Ada a specification or body of BiiN™ 
Ada package, subprogram, or task, presented for compilation as an independent text. (4) In 
BiiN™ C, any primary source file (excluding those that are "included"). 

compiler 

A system program that translates high-level language source files into one or more object 
modules (contained in one or more object module files, depending on the language). 

concurrent 

Happening at the same time. 

concurrent program 

A program divided into pieces that appear to execute simultaneously. 

concurrent programming service 

The OS service that supports concurrent programs, programs with multiple processes and 
jobs executing together. 

configurable object 

TM 

A representation of a hardware or software component of a BiiN node that must be con- 
figured at node initialization, or can be dynamically added to a running system. 

configuration service 

TM 

The OS service that manages configuration of a BiiN node. 
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consistency level 

Within transactions, the level of interference a transaction can tolerate within a file. A 
transaction can have level 1, level 2 or level 3 consistency. 

constant 

A value that does not change; can be either symbolic (named) or literal. 

constraint 

(1) BiiN™ Ada restriction on the set of possible values of a type or subtype. A range 
constraint specifies lower and upper bounds on the values of a scalar type. An accuracy 
constraint specifies the relative or absolute error bound on values of a real type. An index 
constraint specifies lower and upper bounds on an array index. A discriminant constraint 
specifies particular values of the discriminants of a record type or private type. (2) In BiiN™ 
SQL, a restriction on the set of possible values that may be stored in a column. 

constraint_error exception 

BiiN™ Ada built-in exception raised by the BiiN™ Operating System or the BiiN™ Ada 
runtime system when a runtime constraint is violated. Common causes of 
constraint_error are (a) a value that violates a constraint in an assignment statement 
or subprogram call; or (b) a null access descriptor parameter. 

control option 

A predefined directive to a command that modifies the execution behavior or the I/O be- 
havior of the command. A control option consists of a name (prefixed by a double colon, 
: : control_option), and a value ( [=] value). 

control rights 
One of three type rights. By convention, control rights are required to destroy or restructure 
an object. 

countable global object 

A global object that exists so long as any job may be using it. ADs to countable global 
objects are local ADs; such ADs cannot be stored in global objects. 

create right 

A type rights for TDOs and SROs. Creating an object requires create rights on the new 
object's TDO and on the SRO used to allocate the object. 

CRP 

The current record pointer represents the current location in a structured file. 

current directory 

Current location in a directory structure. If a relative pathname is specified, names are 
looked up starting from this directory. The current directory is always stored in process 
globals. 

current record pointer 
See CRP. 

cursor 
(1) In BiiN™ SQL, a named query. The cursor mechanism itself is a pointer that provides 
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row by row access to the result table produced by the query. The cursor can be moved with 
FETCH or FETCH BACK. (2) A special marker that identifies specific cells within a frame 
buffer. For example, a write operation might write characters at a cursor's current location 
and then move the cursor to a new location. 



daemon 

A server process that provides a service asynchronously. For example, daemons service 
spool queues, batch queues, and timed request queues. Memory management daemons 
provide compaction, and garbage collection. 

data abstraction 

The design principle that data representation should be concealed from users of a data type, 
and that data should be defined to users in terms of its behavior, not its representation. 

data area 

A set of disk space allocations on a single volume set. The primary data area contains the 
file's actual data. Secondary data areas are used to allocate space for indexes, 

data definition service 

The OS service that manages data definitions. 

deadlock 

A situation that occurs when two or more processes are blocked and each process is waiting 
for resources or signals controlled by other blocked processes. 

debug object (DO) 

The (internal) part of a domain that contains the symbolic debug information for the domain. 
A debug object is composed of one or more debug units. 

deallocate 

Destroy an object's representation in active memory. If the object has a passive version, 
then its active version can later be recreated. 

declaration 

A program construct that associates a name with a program entity, such as a type, constant, 
variable, or subprogram. 

default 

Value used for an actual parameter if no value is specified in the invocation. 

default transaction 

Transaction (if any) at the top of a process's transaction stack. The default transaction is 
usually the most recent transaction started by the process. Transaction operations use the 
caller's default transaction if no transaction is explicitly specified. 

default value 

A value assigned to a formal parameter when the corresponding actual parameter is omitted. 

delete 

An operation used to remove a record, directory, character, object, or other entity. 
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derived 

(1) In BiiN™ CL, an argument type. A derived argument's type is derived from the value's 
representatioa A value of true or false, or just an argument name, implies a boolean; a 
series of digits implies an integer; a double period, optionally with an integer on either side, 
implies a range; a value in quotation marks is considered a string; string values in paren- 

TM 

theses imply a string list. (2) A category of data types supported in BiiN C: arrays, 
pointers, structures, and unions. 

device 

Physical or logical entity that supports one or more access methods. 

device class 

A specification that defines the devcie-specific details necessary to access a member of a 
class of devices using an I/O mechanism. 

device driver service 

The OS service that supports device drivers. 

device manager 

Module that implements all operations on a particular device type. Implementations of each 
access method supported by the device type are part of the device manager. 

Device Services 

The OS service area that provides support to write and use device drivers. 

directory 

System object that associates names (entry names) with non-null ADs. A directory is the 
main way to associate a name with the AD's underlying object. 

directory entry 

A <name, AD> pair stored in a directory. 

directory name 

Part of a pathname that names the directory containing the named entry. 

Directory Services 

The OS service area that supports associating names with objects, protecting objects stored 
in directories, and retrieving objects based on a given name. 

discrete type 

A BiiN™ Ada enumeration type or integer type. Discrete types are used for array indexing, 
for loop iteration variables, and for choices in case statements and record variants. 

discriminant 

Record component that can determine the subtype of, or the presence or absence of, other 
record components. 

discriminant constraint 

Constraint on a record subtype that specifies a value for each discriminant of the record 
type. 
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disk volume label 

A printable name assigned when a disk volume is logically initialized. This name is stored 
on the disk volume and does not have to be unique. 

dispatch 
Bind a ready process to an available General Data Processor (GDP) for execution. 

dispatching mix 

The set of jobs that are eligible for execution on a node. All processes in a job move in and 
out of the dispatching mix together, under control of the BiiN™ Operating System scheduler. 
A process can be blocked or suspended for other reasons while it is in the dispatching mix. 

dispatching port 

System object at which ready processes are queued to be dispatched and executed by P7 
GDPs. 

distributed 

Property of a service that can be transparently accessed from different nodes in a BiiN™ 
distributed system. 

distributed service 

A service that can be transparently accessed from different nodes in a BiiN™ distributed 
system. For example, the object service, transaction service, naming service, and filing 
service are distributed services. 

distributed system 

A collection of hardware systems (nodes) connected by networks and sharing a common 
clearinghouse and one figurehead naming domain. The operating system unifies all the 
nodes into a single system, by providing distributed services that make data and resources 
accessible from any node, 

domain 

In architectural terms, a domain object, its associated linear address space, and software- 
predefined system objects. 

domain object 

A system object that defines and protects an execution environment. 



elaboration 

(1) Execution of a declaration in a BiiN™ Ada program unit or block. Elaboration executes 
any initialization code for variables or packages elaborated. (2) In BiiN™ Ada, the elabora- 
tion of a declaration is the process by which the declaration achieves its effect (such as 
creating an object); this process occurs during program execution. (3) When using the 

TM 

BiiN Application Debugger, the process by which program entities come into existence at 
run time. For example, the elaboration of a variable declaration involves allocating memory 
for a variable. A program entity cannot be accessed by the debugger until it has been 
elaborated. 
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embedded object 

An object representation that is contained entirely in the object's descriptor. Only zero- 
length objects and semaphores use embedded representations. 

emulation 

An object that interprets higher-level printing functions for a printer and produces the ex- 
pected output by simulating the function using more primitive functions available on the 
target printer. 

enumerated 

In BiiN™ CL, an argument subtype (of type string). An enumerated value has a defined set 
of allowable string values; for example, "start", "middle", "end". 

enumeration type 

Discrete type with values listed in the type declaration. Values of an enumeration type can 
be identifiers or (in BiiN™ Ada) character literals. 

error 

(1) One of the levels of diagnostics generated by the BiiN™ Ada, C, FORTRAN, COBOL, 

TM 

and Pascal compilers and the BiiN Systems Linker. Errors are conditions that may affect 
the generated output, but from which the compiler or linker can recover (by ignoring an 
operand or operation, modifying or ignoring a statement, and so on). Processing continues 
and output can be generated. However, the output may no longer do what you intended. (2) 
One of the exit codes provided by the BiiN™ Ada, C, FORTRAN, and Pascal compilers and 
the BiiN™ Systems Linker. This exit code indicates that one or more error or serious error 
diagnostics were issued. 

event 

(1) An indication of the occurrence of some activity within the system that concerns a 
process or group of processes. Events are local or global depending on the scope of their 
effect. (2) In SMS, a change in state of some object that is of interest to a user. An SMS 
event consists of a target, a condition and an action. 

event cluster 

System object that groups up to 32 events. Each process and job has its own associated 
event cluster. Programs can create additional event clusters and associate processes with 
them. 

event handler 

A procedure executed asynchronously in response to an event. Handler execution interrupts 
normal execution of the process that receives the event 

environment variable 

Another name for a BiiN™ CL variable, especially those variables that control the behavior 
of an executing program. 

exception 

(1) In general, an error condition. (2) A BiiN™ Ada-defined error indication. To raise an 
exception transfers control to an exception handler. If the current block or call does not 
contain a handler for a raised exception, then the exception is propagated to the calling block 
or call, which may handle the exception or propagate it further. (3) A run-time condition 
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that may cause the output of a program to be wrong due to an algorithmic mistake in the 
source program or due to invalid input; also called a run-time error. The term exception 
implies that, in some cases, a routine can be called to handle the situation, and then process- 

TM TM 

ing can continue normally. (4) Raised by BiiN SQL procedures that are called by BiiN 
Ada procedures as an alternative to the standard SQLCODE parameter. 

exception handler 

A sequence of statements executed in response to an exception. Known as a trap handler in 
FORTRAN. 

executable program 

A collection of software modules that has been linked (using the BiiN™ Systems Linker) and 

TM 

is ready for execution on a BiiN system. An executable program must have a main entry 
point and should (but need not) have all of its symbolic references resolved. 

execute 

(1) To perform machine instructions. (2) To perform an I/O Module operation. 

execution environment 

Consists of a linear address space partitioned into four regions (static data, instruction, stack, 
and operating system-reserved), a set of global and floating-point registers, an instruction 
pointer, and an arithmetic control register. 



fault 

A processor-detected error during program execution. For example, if an addition operation 
overflows, the GDP detects the error and raises a fault, which is handled by the BiiN™ 
Operating System as an exception. 

fault tolerant 

Property of a hardware configuration that lets it continue operating after a component failure 
without losing or corrupting data or programs. 

field 

(1) In Pascal, a component or element of a record type. (2) In the BiiN™ operating system, a 
contiguous portion of a record that is an instance of a single data item. 

file 

(1) A collection of information on a physical input or output device. (2) A system object 
that stores data on disk, organized for efficient random access, reading, and writing. Files 
cannot contain access descriptors. Files support byte-stream I/O and record I/O. (3) In 
BiiN™ Pascal, a predefined type. 

file organization 

Data structure used for a file; one of: stream, sequential, clustered, hashed, unordered, and 
relative. 

filing volume set 

A volume set providing external storage space for files and objects. 
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filing service 

The OS service that manages files and records. 

floating-point type 

A numeric data type that represents numbers using exponential notation: j*2**e (where/is 
a positive or negative fraction, normally in the range: 0.5 <= \J\ < 1.0; and e is a signed 
integer). Floating-point numbers can represent a wide range of numbers, but with incom- 
plete precision. They are called "floating point" because the radix point "floats" based on 
the varying exponent, instead of being determined by a fixed scale factor determined by the 
data type. 

form 

A displayable, interactive document with labels and spaces for entering data. 

formal parameter 

A parameter as viewed within the subprogram it is a parameter for. A formal parameter has 
a name, a type, and a mode. Each subprogram invocation associates a different actual 
parameter with each formal parameter. 

form description 

A DDef that describes the physical layout and interactive capabilities of a form. 

form service 

The OS service that manages forms. 

fragmentation 

The division of free storage into multiple non-contiguous segments, caused by the normal 
operation of heap allocation, deallocation, and garbage collection. 

frame buffer 

The drawing space of a virtual terminal. An application writes to the frame buffer as- 
sociated with a virtual terminal. Part of the frame buffer is visible to a user through a 
window; this visible part is called a view. 

frozen memory 

Memory for system objects that are never swapped out to disk and never relocated by com- 
paction. Contrast with normal memory. Frozen objects can be accessed without page faults 
or delays due to compaction. However, resizing a frozen object may make it inaccessible 
during the resize operation. 

full pathname 

A pathname with three leading slashes. The BiiN™ OS evaluates full pathnames by first 
discovering which node to begin from, which may require a call to the Clearinghouse. 

function 

(1) A BiiN™ Ada, FORTRAN, or Pascal subprogram that returns a value to its caller. (2) 
The primary unit from which C language programs are constructed. Functions need not 
return a value to the caller. All C functions are external; that is, a function cannot contain 
another function. (3) In BiiN™ SQL, one of a set of five "built-in" functions that take the 
rows in a table or the set of values in a column as an argument (MIN, MAX, SUM, AVG, 
COUNT). 
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2 30 = 1,073,741,824. For example, 1G bytes equals 1,073,741,824 bytes. 

garbage collection 

The process of identifying and reclaiming active objects that can no longer be accessed. 
Garbage collection reclaims both memory and object descriptors for reuse. Garbage collec- 
tion is asynchronous and transparent to applications software. A global garbage collector 
reclaims global garbage and runs at every node, under administrative control. A local gar- 
bage collector is configured in a job if the running program requests it 

garbage object 

An active object that cannot be accessed because it cannot be reached via active ADs. A 
garbage object can be reclaimed by garbage collection. 

generic object 

An object used as just a memory segment. A generic object does not have a type manager 
and all generic objects have the same TDO. 

generic package 

An Ada template for a package. Such a template can be instantiated with parameters at 
compile-time to create a package. 

generic subprogram 

An Ada template for a subprogram. Such a template can be instantiated with parameters at 
compile-time to create a subprogram. 

generic unit 

BiiN™ Ada template for a set of packages or subprograms. A package or subprogram 
created using the template is an instance of the generic unit A generic instantiation is the 
kind of declaration that creates an instance. A generic unit is written as a package or sub- 
program specification prefixed by a generic formal part that may declare generic formal 
parameters. A generic formal parameter is either a type, subprogram, variable, or constant. 



(1) An object or entity that is not local to a particular job. (2) A program-defined entity, 
such as a type, constant, or variable, that is declared outside a particular subprogram. 

global AD 

An AD that can be stored in a global object A global AD's local bit is zero. A global AD 
normally references a global object 

global debug table (GDT) 

A table of compilation units and their addresses generated by the BiiN™ Systems Linker. 

global garbage collector 

A memory management daemon that reclaims global garbage at a node. The global garbage 
collector is invisible to applications software. A system administrator controls a node's 
global garbage collector. 
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global memory 

The collection of global objects in a node's active memory, combined with the free global 
memory available in the node's global SROs. 

global object 

A system object that exists outside of any particular job. A global object may be a countable 
global object or unbounded global object. 

global SRO 

An SRO used to allocate global objects. A node's active memory contains two global 
SROs, the normal global SRO and the frozen global SRO. 

global variable 

Global variables exist for the duration of a session. Variables created or modified by a 
program are local to the creating job, unless specified as global. Global variables are in- 
herited by subsequent jobs in the same session. 



handler 

TM 

Code that is invoked by the BiiN Operating System or a language run-time system in 
response to an asynchronous occurrence rather than an application call. A handler can be an 
event handler, exception handler, or interrupt handler. 

handler object 

The handler object is a compiler-defined object that contains a table of the exception hand- 
lers defined in a domain. It is used by the compiler's runtime system to find the correct 
handler for a given exception. 

hashed+file 
A structured file whose records are organized according to a hashed organization index. 

HDLC service 

The OS service that manages High-Level Data Link Control communication. 

head object 

The initiating member of a pair of configurable objects associated with each other. A head 
object is characterized by its ability to function normally without being attached to another 
configurable object. 

high-level scheduling 

Putting a job in the hardware dispatching mix. When a job is invoked, it is enqueued on a 
scheduling port served by a scheduling daemon. When the daemon is activated, it removes 
the job from the port and schedules it by enqueueing the job's initial process at the end of 
one of the queues in a dispatching port. The port has 32 queues, ordered in priority from 
(lowest) to 31 (highest). A process enqueued in this manner is said to be in the mix. 

history 

A record of occurrences. 

history log file 

A file of commands entered, and messages written, for a given job, session, or command. 
See command history. 

Glossary X-B-17 



PRELIMINARY 



home directory 

Directory in which a user is placed after a successful login. The home directory is typically 
the highest directory owned by the user. All other stored objects owned by the user are 
normally subordinate to the home directory. 

home node 

The node at which a stored object's home volume set is currently mounted. 

home volume set 

The volume set that contains a stored object's passive version. 

homomorph 

An active version created as a token in place of a single- activation object that is only ac- 
tivated in a different home job or home node. The object's type manager must communicate 
with its counterpart at the home job or home node in order to access the object. Users of an 
object, outside its type manager, cannot distinguish between a homomorph and the object 
that it stands in place of. 

Human Interface Services 

The OS service area that provides integrated packages for quickly developing applications. 
All services in this area are based on a data definition (DDef) that supports the idea of 
building complex structures from small pieces (forms and reports), and that might be used to 
create informational output. 



ID 

(1) A system object that represents a particular class of access to a BiiN™ system. Each user 
is represented by an ID. Each group of users that share access to particular objects can be 
represented by an ID. The "world" class, denoting access granted to arbitrary other users, is 
represented by an ID. Application programs and type managers can use IDs to restrict 
access to stored objects to only certain programs or modules. (2) An index that identifies 
the device or controller to which an I/O module command/operation is directed. 

ID list 

A system object that contains a list of IDs. Each process has an associated ID list, 
referenced by its process globals, used for authority list evaluation in retrieving stored ADs 
protected by authority lists. 

I/O message 

A data transfer mechanism that is composed of four parts: a common, fixed part, a part for 
the exclusive use of a device driver and I/O processor, a part for the exclusive use of a 
device manager, and an array of buffer descriptions. 

I/O shared queues 

A data transfer mechanism employing an input and output queue per device. Designed for 
low-speed, character-oriented I/O, such as character terminals and printers. 

I/O Services 

The OS service area that supports all input/output to and from files and devices. 
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image module 

An independently linked, protected, and potentially shareable piece of software that is bound 
to a program at runtime. Image modules support runtime linking, protection, and sharing. 

incident 

A BiiN™ construct that assigns a unique identifier, an incident code, to each error or excep- 
tional situtation. An incident code references a message file, an individual message within 
that file, and a severity level. 

incident code 

Representation of a software incident. An incident code indicates the module which defines 
the incident, the incident number within the module, the incident severity, and a pointer to a 
message file. 

index 

The mechanism in which a data value is presented to an ordered list that contains the loca- 
tion of the desired value in a file. The index does not often contain all the values of the data 
item, but simply a limiting range of values. An organization index is an index for a clus- 
tered file or hashed file that influences the placement of records in the primary data area. 
An alternate index is an index in a structured file that in no way influences the placement of 
records in the primary data area. 

index constraint 

TM 

A restnction on a BnN Ada array type or subtype that specifies the lower and upper 
bounds (and thus the number of values) for each index (subscript) of the array. 

index type 

The type of the array selector or index that is used to reference an element of a Pascal array. 
A Pascal index type must be an ordinal type. 

initial_age 

A job's age when it first enters the scheduler's waiting queue of swapped-out jobs. Larger 
values indicate older jobs. The job at the head of the queue is the oldest job and is 
scheduled for execution before the other jobs in the queue. 

input event 

An action performed by the user when interacting with an appliation through a terminal 
window. Typical examples are mouse and keyboard input events. Input events are for- 
warded to the application. 

input focus 

The virtual terminal to which a physical terminal's keyboard and mouse input are connected 
at a given time. 

instance 

Member of a class. For example, an instance of an attribute, an instance of a generic pack- 
age. 

instantiation 

Operation performed by the BiiN™ Ada compiler to create an instance of a generic package 
or subprogram. 



Glossary X-B-19 



rKKLlMirSAKX 



instruction object 

The predefined system object that contains the code belonging to a particular domain. This 
object represents the instruction region, region 1. 

integer 

(1) An exact representation of a positive, negative, or zero value. (2) In BiiN™ CL, an 
argument or variable type. (3) One of the data types of BiiN™ FORTRAN, hi BiiN™ 
FORTRAN, an integer datum can occupy 1, 2, 4, or 8 bytes; the default is 2 or 4, depending 
on the value of the compiler's : int size argument (4) In standard Pascal, a sequence of 
decimal digits. In BiiN™ Pascal, a sequence of binary, octal, decimal, or hexadecimal digits. 

integer type 

(1) Any type containing only whole numbers in a particular range. (2) One of the C- 
language data types char or int (all sizes, signed or unsigned). (3) One of the Pascal data 
types: char or integer. 

interactive job 

A job that interacts with a human user. Interactive jobs run in normal memory, have limited 
processor claim, and have a lower priority than real-time and time-critical jobs. 

interrupt 

Asynchronous hardware signal indicating some occurrence (such as I/O) that requires action 
by an I/O module. 

interrupt handler 

A procedure invoked in response to an interrupt. 

interrupt reply procedure 

A subprogram specified by a device manager in an I/O message that enables a device 
manager to process the reply information contained in an I/O message that has been serviced 
by either an I/O processor or a device driver. 

invocation command 

A BiiN™ CL command that invokes (calls and starts) a program or BiiN™ CL script. 



job 

A system object that represents an executing program. Each job has its own storage 
resource and its own address space. Each job has its own processing resources; scheduling 
for a node is done on a per-job basis. Resource control and reclamation is done on a per-job 
basis. A job can contain multiple processes executing concurrently. 



K 

2 10 = 1,024. For example, IK bytes equals 1,024 bytes. 

key 

A value used to designate a data item in a record. A primary key is a key value that 
uniquely identifies a record in a file. A key value that does not uniquely identify a record in 
a file is a secondary key. 



X-B-20 Glossary 



K 



PRELIMINARY 



kidnapped process 

Process interrupted by an interrupt handler. The process is restored to its prior state and 
resumes execution when the handler completes. 



LAN service 
The OS service that manages Local Area Network communication. 

library unit 

A compilation unit that is not a subunit of another unit. Library units belong to a program 
library. 

lifetime 

A system object characteristic that determines how long an object can exist and how the 
object can be deallocated. There are three possible lifetimes: local, countable global, and 
unbounded global. Local objects are local to a job, exist no longer than their job, and can be 
deallocated by job termination or a local garbage collector. Countable global objects are 
shared by one or more jobs and can be deallocated when the jobs are no longer using the 
objects. Unbounded global objects have an unbounded lifetime and can be reclaimed by 
global garbage collection when the objects are no longer accessible via any AD. 

lifetime check 

A check, whenever an AD is copied, to ensure that a local AD is not copied into a global 
object. Attempting such a copy raises 

System_Exceptions . lif etime_violation. 

limited type 

A BiiN™ Ada type that does not allow assignment or comparisons for equality. 

linear address 

A word interpreted as a 32-bit ordinal that specifies a byte offset into a linear address space. 
Bits 30 and 31 specify one of four region objects. Bits 0-29 specify a byte offset into the 
selected region. Region contains static data. Region 1 contains instructions. Region 2 is a 
stack. Region 3 is used by the OS and is identical for all linear address spaces at a particular 
node. 

linear address space 

A 2 32 byte (4G byte) address space partitioned into four regions, defined by a domain and a 
particular process. A domain contains ADs for region (static data object) and region 1 
(instruction object). A domain contains a subsystem ID that determines which of a 
process's stacks is used as region 2. Region 3 is defined by the OS and never changes. The 
linear address space contains holes where region objects are less than 1G byte in size. 

link object 

A system object with an system object type that supports the BiiN™ Operating System link 
attribute. When an AD for a link object is retrieved from a directory, an associated link 
evaluation function is called to evaluate the link and return a different AD. For example, a 
symbolic link system object contains a pathname. Retrieving an AD for a symbolic link 
triggers the retrieval of the AD named by the pathname in the symbolic link object. 
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linker 

The BiiN™ software tool that combines the object modules created by the BiiN™ Ada, C, 
FORTRAN, COBOL, Pascal, and SQL compilers with the languages and systems environ- 
ment to build an executable program. Besides producing the executable program directly 
from the object modules created by compilers, the linker can also produce image modules 
from object modules. 

literal 

(1) A symbol or number that represents a specific value rather than naming a value defined 
elsewhere (variable or constant) or describing a computation (expression). A literal can be a 
numeric literal, enumeration literal, character literal, or string literal. (2) In BiiN™ SQL, the 
representation of character strings, exact numeric values (FIXED) and approximate numeric 
values (FLOAT). 

lock 

An entity that allows a transaction or opened device to ensure that it alone has access to a 
particular resource. 

local 

(1) An object or entity that is local to a particular job. (2) A scope of an entity, such as a 
constant or variable, that is declared and visible only within a particular subprogram or 
block. 

local AD 

An AD that is local to a job. A local AD cannot be contained in or copied to a global object. 

local bit 

A bit in an AD that is one in a local AD and zero in a global AD. The local bit is not 
interpreted in null ADs. 

local garbage collector 

A memory management daemon that reclaims local garbage within a job. A running 
program must request local garbage collection or else no daemon is created for the job. 
Once requested, local garbage collection is invisible to the application. 

local object 

A system object that is local to a particular job. When a job terminates, all its local objects 
are deallocated. 

local SRO 

An SRO used to allocate local objects. Each job has one local SRO. 

local variable 

Local variables exist only for the duration of a job. A variable created or modified by a 
program is local to the creating job, unless specified as global. 

low-level scheduling (dispatching) 

Assigning a process to a processor. Each processor has a pointer to a dispatching port. 
When a processor is available to execute a process, it dequeues the first process from the 
highest numbered, non-empty queue in the port, and executes it. 
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2 20 = 1,048,576. For example, 1M bytes equals 1,048,576 bytes. 

mandatory argument 

An argument that must be entered as part of a complete command. 

mass storage service 

The OS service that manages disk and tape storage. 

master AD 

The first access descriptor stored in passive store for a particular object An object's passive 
version is deleted when its master AD is deleted. If a master AD is stored in a directory 
entry and other directory entries on the same volume set reference the same object, then 
deleting the master AD converts the AD in one of those other entries to a master AD, 
preserving the object. 

medium-level scheduling 

The process of dynamically assigning priorities to executing processes. Medium-level 
scheduling considers a process's running priority, service class, and dynamic behavior. 

memory type 

The kind of memory used by a system object, either normal memory or frozen memory. 

menu service 

The OS service that manages menus. 

message 

(1) Information issued by an executing program in response to some internal or external 
incident A message can have three levels (short, long, and help) and can exist in various 
message languages (English, German, etc.). (2) Information used in executing the action 
associated with an SMS event. For an action class of command, the message becomes a 
process global that contains information for the batch job that is triggered by the event. For 
an action class of mail, the message is sent to the mailboxes listed in the action refinement 

message file 

The container for a program's messages. 

message service 

The OS service that manages system and application errors and messages. 

message stack 

A stack that can be used to push and pop messages as execution continues. A message stack 
can thus contain a traceback of an error's propagation path from the point of error back 
through the various layers of software to the topmost level. Each process has a message 
stack associated with it. 

menu 

A list of choices provided by a program. There are two types of menus: "pull-down menus" 
from Window Services, and "screen menus" from the Menu Facility. Pull-down menu titles 
are displayed in a line at the top of a window; selecting a pull-down menu title causes the 
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menu itself to be displayed. A screen menu (with its menu items) is displayed in a window 
under program control. Screen menus may have hierarchies of menus and submenus. 

Menu Editor 

System utility used to interactively create and modify menus. 

Menu Handler 

Ada package that processes menus. 

menu item 

Element of a menu representing one of the choices available in the menu. Composed of the 
displayed menu item text, and the returned menu item index; see the 
Window_Services package. 

mode 

The mode of a variable is either "read-only", meaning that the variable can only be read, or 
"read- write", indicating that the variable may be read or assigned a value. 

modify rights 

One of three type rights. By convention, modify rights are required to change an object's 
state. 

monitor service 

The OS service that supports monitoring of program execution. 

multiple activation model 

An activation model that activates an object in any job or node. Compare with single 
activation model. 



name 

(1) A character string label for an object or a stored AD. (2) A program-defined label for a 
program entity, such as a type, variable, constant, exception, package, or subprogram. 

name space 

TM 

A name space is a list of directories to be searched by the BiiN OS when looking for an 
object. This is similar in function to the UNIX environment variable PATH or the MS-DOS 
PATH command. 

named association 

TM 

A BiiN Ada construct that binds a parameter or an aggregate member to a value; has the 
form name => value. 

named notation 

(1) Entering an argument value to a command by specfying the name of the argument. (2) A 

TM 

BiiN Ada construct. 

naming service 

The OS service that provides packages to manage pathnames, directories, and lists of direc- 
tories. 
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node 

A single BiiN™ hardware system. Multiple nodes can be combined into a single distributed 
system. 

node pathname 

A pathname with one leading slash. The BiiN™ OS evaluates node pathnames beginning at 
the calling node's root (top) directory. 

normal memory 

Memory for system objects that can have pages swapped out to disk and that can be relo- 
cated by compaction. Contrast mthfrozen memory. Accessing a normal object may en- 
counter delays waiting for pages or waiting for compaction to relocate the object. 

null 

(1) An invalid address, a pointer to nothing. (2) In general, empty or missing. 

o 

offset 

An unsigned displacement from some base address, typically from the beginning of an ob- 
ject. An offset is in bytes unless other units are explicitly specified. 

object 

(1) A typed, protected memory segment. Such an object is also called a system object. (2) 
In Ada: a typed container for a value, such as a variable or constant. An Ada object may or 
may not be represented by a separate memory segment. 

object address space 

Up to 2 26 system objects simultaneously addressable in a particular node's active memory. 

object descriptor 

A data structure used to hold various system object characteristics: size, location in 
memory, AD to the object's TDO, and other information. Object descriptors are internal to 
the OS; object descriptors are only described because it is difficult to explain how objects 
are located, sized, and typed without mentioning them. 

object index 

A field in an AD that identifies a particular object. In an active AD, the object index is a 
26-bit index into the node's object table, selecting the object's descriptor. 

object orientation 

(1) A set of characteristics that enhance the coherence and security of integrated systems. 
The principal characteristic of object orientation is the use of protected data structures called 
objects to represent parts of the system itself as well as application entities. Objects are . 
addressable and protected by cooperating hardware and software mechanisms. (2) An intui- 
tive style of user interface that emphasizes representation of real- world entities rather than 
implementation-oriented details. 

object representation 

The contents of a system object. An object's representation can contain from zero to 4G 
bytes. The representation is not synonymous with the object itself because an object has 
several other characteristics, such as object type and attributes. Accessing an object's 
representation requires an AD or virtual address with rep rights. 
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object section 

In the BiiN™ OMF, a contiguous portion of an object. 

object service 

The OS service that provides calls to manage objects, access to objects, and storage of 
objects. 

object table 

An object that contains all object descriptors for objects that are in a node's active memory 
or that have active ADs on the node. There is one object table per node. The object table is 
internal to the OS; it is described only because it is difficult to explain how objects are 
located, sized, and typed without mentioning the object table. 

object tree 

A collection of passive objects, beginning with a single root object, and linked by master 
ADs. An object x is in the tree if and only if x is the root object or another object in the tree 
contains x's master AD. Because master ADs cannot refer to objects on other volume sets, 
all objects in an object tree are on the same volume set as the root object. 

object type 

A set of object attributes that indicates such characteristics as its purpose, visibility, and 
usability by other system elements. Some types define objects that are recognized by the 
processor and for which special instructions are provided. Software-defined types can be 
manipulated only by a type manager corresponding to the type of the object. 

object-specific attribute 

An attribute that is defined differently or not defined at all on a per-object basis. 

operator 

A programming language element that specifies an operation to be performed on one or 
more operands in an expression. 

operating system 
The OS provides: 

• General management of objects: object-oriented storage, protection, naming, and pro- 
gramming. 

• Control and accounting for system resources, such as memory and processing recources, 
in a multiuser environment. 



Device-independent I/O access methods. 

Support for concurrent programming. 

Distributed services, so that applications built on those services are naturally distributed. 

High-level services commonly needed by many applications, such as messages, struc- 
tured files, commands, forms, and reports. 



System Services is the programmer's interface to the OS. 

optional argument 

An argument to a command that need be entered only if a value other than the default is 
desired. 
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organization pathname 

A pathname with 2 leading slashes. The BiiN™ OS evaluates organization pathnames by 
first discovering which node to begin from, which may require a call to the Clearinghouse. 

outside environment object (OEO) 

An object that references the command definitions and messages associated with a program. 
These are used by the command language executive (CLEX). 



package 

An Ada module containing logically related types, constants, variables, exceptions, sub- 
programs (calls), and tasks. A package is represented by two separate compilation units, a 
package specification and a package body. 

package body 

The implementation of an Ada package specification. The body includes implementations 
for each subprogram in the package specification, any private data and subprograms internal 
to the body, and any needed package initialization code. 

package specification 

The external interface to an Ada package. Declarations in the public part of a package 
specification can be used from outside the package. A package specification can also con- 
tain a private part that provides information needed by the compiler but not available to 
external users. 

package type 

A package specification that can have alternate bodies, with a body selected for each call 
depending on the object type of the first actual parameter. Compare with attribute call. 

page 

(1) A 4K-byte memory block, aligned on a 4K-byte boundary. (2) A printed page. 

page descriptor 

A data structure that locates a particular memory page and that contains access rights and 
status information for the page. 

page table 

A table that locates the pages of a paged object. The table contains an array of page descrip- 
tors. 

page table directory 

A page table that locates the pages of a large page table that is itself paged. 

paged object 

A large object that is stored in multiple pages of physical memory. The object descriptor for 
a paged object references a page table that in turn references the pages of the object. 

paging 

The process of moving pages between physical memory and a swapping volume set. Pages 
are loaded into physical memory on demand. Modified pages are written to the swapping 
volume set by an asynchronous paging daemon. 
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panning 

Moving a view up or down in its frame buffer in order to see a different part of the frame 
buffer. Also called scrolling. 

parameter 

A value or variable that can be different for each invocation of a subprogram, and thus is 
supplied for each invocation. A formal parameter represents a parameter within a sub- 
program body. An actual parameter is the actual value or variable supplied for a particular 
invocation. 

parameter mode 

For an Ada parameter, one of: 

in The parameter is a value that is read but not written, 

out The parameter is a variable that is assigned but not read. 

in out The parameter is a variable that can be read or assigned. 

passivate 

Copy an active version of a system object to its passive version. 

passive AD 

An AD in passive store. 

passive object 

A system object in passive store, a passive version. 

passive version 

An object's version in passive store. An object can also have zero or more active versions. 

passive store 

The distributed object filing system for storing system objects on disk. Compare with active 
memory. 

pathname 

(1) A string of names that contains slashes and is a "path" of directories from a point in a 
directory structure to an entry. BiiN™ uses four kinds of pathnames: relative, node, or- 
ganization, and full. (2) A series of base names, separated by slashes, that uniquely iden- 
tifies an element in a form. 

physical address 

A 32-bit address of a physical memory location or memory-mapped device register. 

physical address space 

The 2 32 byte address space used by the BiiN™ hardware. 

physical memory 

A node's semiconductor memory, whether normal RAM (volatile, read-write), battery- 
backed-up RAM (non-volatile, read-write) or ROM/EPROM/EEPROM (non-volatile, read- 
only for normal uses). Compare with active memory. 
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physical terminal 

A video display device with a keyboard. It may also have a pointing device (mouse). 

pipe 

A software-defined object that supports interprocess communication (in one direction only). 
One process writes to the pipe and the other reads from it. The pipe uses a fixed-size buffer 
to hold data written by the first process but not yet read by the second process. The writing 
process will block if the buffer is full, and the reading process will block if the buffer is 
empty (the processes resume when these conditions no longer hold). 

pointer 

(1) A variable that contains the address of another variable or of a function. (2) In BiiN™ 
CL, an argument or variable type. A pointer value is a pathname to a passivated object. 

port 

An interprocess communications mechanism consisting of queued data structures that use 
shared memory and provide communications for processes within a single job. Ports con- 
tain messages, blocked processes, or are empty. Ports are the appropriate message 
mechanism when fast and simple message passing is needed. 

positional notation 

Providing the value of a command argument by specifying the value at the appropriate 
position in the command's argument list 

pragma 

A directive to the Ada compiler, embedded in an Ada source file. Pragmas can provide 
important semantic information, such as how pointers are represented, or whether a sub- 
program can be called from another language. 

print device 

A device created by an application through which data is spooled or printed directly. 

print service 

The OS service that manages printers. 

printer 

An object that represents a physical printer connected to the system. 



A set of attributes describing the capabilities of a printer. 

procedure 

(1) A program unit in BiiN™ Ada, FORTRAN, or Pascal that is invoked by a call statement. 
Unlike a function, a procedure does not return a value. (2) In BiiN™ COBOL, a paragraph 
or group of logically successive paragraphs, or a section or group of logically successive 

TM 

sections, within the Procedure Division. (3) In BiiN SQL, a collection of one or more SQL 
statements that can be called by a host language module. Procedures are grouped into SQL 
modules. (4) A program in CP microcode that forms a part of an IOM microcode program. 

process 

The smallest unit of scheduling; a single thread of execution; represented by a processor- 
recognized object. Processes specify execution environments for running programs. 
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process globals 

A data structure that defines the environment in which a process executes. It is a list of ADs 
associated with the process. 

process preemption 

Forcing a running process to relinquish the processor to another process waiting in the dis- 
patching port. It occurs if the waiting process has a higher priority than the running process 
and is a preemptive process (has a priority higher than the preemptive threshold). 

processor claim 

The number of time slices available to the processes in a job during each scheduling cycle. 
When the claim is exhausted, the scheduler terminates the job if it has exceeded its time 
limit, or obtains more processor claim if it hasn't (allowing the job to continue). 

program 

(1) A complete collection of software modules that are designed to accomplish a given piece 
of work. There are several kinds of programs: dialogue programs (which accept runtime 
commands), start-and-go-programs (which accept runtime commands), application 
programs, and system utilities. A program may be invoked interactively from the keyboard 
or batched in a BiiN™ CL script. An executable program is the linked version of a program. 

(2) In Ada, a program is composed of a number of compilation units, one of which is a 
subprogram called the main program. Execution of the program consists of execution of the 
main program, which may invoke subprograms declared in the other compilation units of the 
program. 

program building service 

The OS service that provides support for building programs: creation, execution, and 
debugging. 

program object 

The root of a network of objects that comprise a program. A program object is created by 
the linker and referenced by a program AD. The linker stores the program AD in a directory 
after creating the program. A program consists of a program object, a global debug table 
(GDT), an outside environment object (OEO), and one or more domain objects. 

Program Services 

The OS service area that provides support for concurrent programming, program building, 
and resource control. 

protection service 

The OS service that provides packages to manage users, IDs and authority lists. 

protection set 

List of IDs and associated access rights. A protection set is associated with an ID, and a 
caller must hold an ID that matches one in the protection set, with the appropriate rights, 
before the caller can access that ID. 

public data object 

An object containing data that can be referenced from other domains (domains that have an 
AD to the public data object in their static data objects.) 
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pull-down menu 

A menu that is activated by a mouse and which appears only on explicit request of the user. 
After a user has selected menu items from the menu, the program can determine the menu 
choices by calling the appropriate terminal access method. 



range 

In BiiN™ CL, an argument or variable type. Range values are composed of two integers that 
are separated by a double period (lower_integer . . upper_integer). 

rank 

(1) Default order in which spool files will print. (2) Default order in which subform group 
instances will be displayed in a form. 

read rights 

A type right required for many devices and opened devices, in order to read data using an 
I/O access method. Read rights rename use rights. 

read rep rights 

Rights bit that must be 1 to read an object's representation. ADs and virtual addresses 
contain read rep rights. 

real-time job 

A job that is executed in real time because it cannot wait for objects to be brought into 
memory or for another job to finish with a processor before executing. Real-time jobs have 
very high priority and infinite processor claim. They run in frozen memory, and are not 
subject to the scheduling process. If they block for I/O, the hardware reschedules them 
immediately. 

real type 

A simple data type that represents a floating-point number. 

record 

(1) In the BiiN OS, an element of a structured file. Each record in a structured file has a 
unique record ID that can be used to access the record. A record has a format that is either 
fixed-length or variable-length. (2) In COBOL, the most inclusive data item. The level- 
number for a record is 1. A record may be either an elementary item or a group item. (3) 
In BiiN™ Pascal, a predefined type. (4) The unit of information in an object module. The 
BiiN Systems Object Module Format specifies about a dozen records, each of which con- 
tains specific information about the object module. These records are a header record, 
various symbol and object definition and reference records, and an end-of-module record. 

record access method 

An access method that transfers data in record-like units, in various access modes. 

record type 

A structured data type consisting of a fixed number of components (fields), possibly of 
different types, that are referenced by means of identifiers. 

recovery agent 

Process provided on each node by the OS that detects I/O processor failures and maintains a 
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table of existing I/O messages. Device managers keep this list current by calling 
DD_Support . Register_XO_mes.sage each time they create an I/O message. 

region 

(1) An area within a form. Valid regions are: the form as a whole, a subform, a group, a 
screen field or an enumeration. (2) A linear address space is partitioned into four 1 -gigabyte 
system objects called regions. Region contains static data, region 1 contains instructions, 
region 2 contains the stack, and region 3 is used by the operating system. Calling another 
domain in the current subsystem can change regions and 1. Calling a domain in another 
subsystem can also change region 2. If a region contains less than one gigabyte, then the 
linear address space contains invalid parts. Reading or writing with an invalid linear address 
raises SystemJExceptions . length_violation. 

relative file 

A structured file whose records are organized in an array of fixed-size record slots that may 
or may not contain information. A relative file can be read or written in any order. 

relative pathname 

A pathname with no leading slashes. The BiiN™ OS evaluates relative pathnames relative to 
a specific directory; by default, the current directory. 

rep rights 

Rights bits required to read or write an object's representation. ADs and virtual addresses 
contain rep rights. There are two rep rights: read rep rights and write rep rights. 

representation type 

An object characteristic that specifies which of the four kinds of object representation is 
used: embedded, simple, simply-paged, or bi-paged. 

report 

A printed or displayed document containing labelled data, often presented in columns and 
hierarchical groups with subtotals and totals. 

report description 
A DDef that describes the format of a report and the data to be printed in it. 

report service 

The OS service that manages reports. 

reservation service 

The OS service that supports the reservation of devices for exclusive use by a session. 

resource priority 

A process's resource priority. When an interactive or batch process requests the use of a 
resource (for example, a disk), the process's priority is raised to the sum of its base, bias, 
and resource priorities (but still in the range 1 to 10). 

resource service 

The OS service that supports resource control and accounting. 
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rights 
Bits in an AD that control access to a system object There are two kinds of rights: rep 
rights and type rights. Rep rights are required to read or write an object's representation. 
Rep rights are checked and enforced by the CPU. Type rights are required to invoke certain 
type manager calls with an object. The interpretation of type rights varies for different 
object types. Type rights are checked and enforced by type managers. Rights are not 
interpreted in null ADs. 

rights mask 

A record representing rights to be checked, added, or removed in an AD. 

running priority 

The priority at which an interactive or batch process is currently running. It fluctuates 
between the process's base priority and the priority of the resource the process requested 
most recently. 

runtime command 

A command that is processed by a program, using the command service. Runtime com- 
mands are defined in command sets. Command sets can be stored in the program's outside 
environment object (OEO), or as separate objects. 



scalar type 

A data type whose variables have a single value; also called a simple type. 

scheduler 

A collection of hardware and software entities that together schedule the execution of jobs 
(and thus processes). The scheduler seeks to maximize the use of system resources by 
scheduling processors, physical memory, and I/O devices. 

scheduling service object (SSO) 
An object that determines the type of scheduling a job receives by specifying the job's 
service class, priority, time slice, memory type, initial age, and age factor. An SSO is 
associated with a job when the job is invoked. The system administrator is responsible for 
creating different types of SSOs and controlling access to them, thus controlling the type of 
service granted to different jobs. 

scheduling service 

The OS service that manages scheduling of jobs and processes. 

scope 

(l)The part of a form in which an element exists and can be referenced. A form element is 
in a form, or contained in a subform, a group, or a pile, i.e., in another form element. At any 
one time the editing scope extends only to elements located directly in the form, or directly 
in a subform or group, or directly on a pile. Only elements in the editing scope can be 
edited. (2)The portion of a program in which a program entity exists and can be referenced. 

scrolling 

Moving a view up or down in its frame buffer in order to see a different part of the frame 
buffer. Also called panning. 
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semaphore 

An object for controlling and synchronizing access to data that may be shared by concurrent 
processes. 

sequential file 

A structured file whose records are organized in the sequence they are physically written. A 
sequential file must be read in exactly the same order that it was written. 

service 

A logically related set of packages or other program modules. A service provides com- 
pletely procedural solutions to problems. Applications call services on behalf of users, but 
users do not directly interact with services. Compare with tool and utility. 

service class 

Denotes the general class of service a job is to receive. Four service classes are defined: 
realtime, time-critical, interactive, and batch. 

service area 

A logically related set of services. 

session 

A grouping of jobs belonging to one instance of a user's interaction with the system. A 
session typically contains several jobs. A session is usually an interactive logon/logoff 
period, but can also be the running of a batch command file. 

set 
In BiiN™ Pascal, a predefined type. 

simple object 

An object representation that fits entirely into all or part of one memory page. A simple 
object's size ranges from 64 bytes to 4K bytes. 

simply-paged object 

An object representation that requires multiple memory pages, but with a page table that fits 
entirely into all or part of a memory page. Compare with bi-paged object. A simply-paged 
object's size ranges from 8K bytes to 4M bytes. 

single-activation model 

An activation model that activates an object only in a particular home job (for local objects) 
or home node (for global objects); another job or node that attempts to activate the object 
instead activates a homomorph, a token object that stands in place of the actual object. 

spin lock 

A synchronization device used during the processing of I/O messages with calls that raise 
and restore interrupt handler priority levels. 

spool file 

A buffer maintained by a spool queue that holds data from print device objects which is to 
be printed. 
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spool queue 

A spool device that must be installed before anything can be printed. 

spool service 

The OS service that manages spoolers. 

SSO priority 

The priority defined in a job's SSO. 

stable store 

Non-volatile RAM storage that is used to optimize I/O throughput from active memory to 
disk. Using stable store, writes to disk can be delayed indefinitely, which greatly reduces 
I/O access time. 

stack 

System object that provides a stack of frames that each contain the state of a particular 
subprogram call. 

standard kernel image 

Factory-supplied OS preconfigured to run on a system disk and a console terminal. 

starter image 

A self-contained, linked image that does not need a secondary store (such as a disk) for 
operation, and which is booted into memory from a distribution channel (such as a tape) for 
the sole purpose of executing certain system utilities to prepare the physical system to be 
operable under an OS standard kernel. 

statement 

(1) A program construct that defines actions to be performed by the program. (2) A source 
program construct at which a breakpoint can be set when using the BiiN™ Application 
Debugger. In general, any construct that is considered a statement in the formal definition 
of the language is also considered a statement by the debugger. However, the following 
constructs are not considered statements for debugging purposes: 

• Any declaration in any language (or definition in C) other than a variable declaration 
(definition) involving dynamic initialization or a subprogram declaration (definition). 

• Any declaration (as opposed to definition) in C. 

In addition, subprogram declarations are always considered statements by the debugger, 
regardless of their treatment by the source language. 

static data object 

System object that contains the data for a particular domain. This object represents the static 
data region (region 0). 

storage resource object (SRO) 

An object used to allocate other objects. An SRO provides access to available memory and 
to available object table entries. The SRO used to allocate an object determines the object's 
memory type and whether the object is local or global. Each job has a local SRO, used to 
allocate objects local to the job. Each node has two global SROs, one for normal memory 
and one for frozen memory. 
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stream file 

A stream of bytes that allows random byte positioning. This UNIX-like file organization is 
useful if you simply want to read and write bytes. 

string 
(1) In BiiN™ CL, an argument or variable type. String values are sequences of characters, 
enclosed in single or double quotation marks (e.g., ' string' or "string"). If there are 
no spaces, tabs, or linefeeds in a string, the quotation marks are optional. One string subtype 
is enumerated, for which a set of allowable string values is defined. (2) In standard Pascal, a 
sequence of one or more characters, enclosed by apostrophes, representing a value of type 
CHAR (if a single character) or of type PACKED ARRAY [ 1 . . n] OF CHAR, where n is a 
positive integer equal to the number of array elements. (3) In BiiN™ Pascal, STRING is a 
reserved word, used as a type denoter. 

string list 

In BiiN™ CL, an argument or variable type. String list values are sets of strings, enclosed in 
parentheses (e.g., ( st ringl, string2, string3) ). The string values may be 
separated by spaces, tabs, or commas. If a string list contains just one string value, the 
parentheses are optional. 

structured file 

A file containing records of either fixed or variable length. Structured files optionally can 
have indexes. Structured files are useful if you need a way to maintain record structures. 
Structured file I/O is typically accomplished using record I/O. A structured file can have 
one of these organizations: clustered, hashed, relative, sequential, or unordered. 

subnet 

Informal term for subnetwork. 

The OS service that provides network-independent communication between nodes within a 
subnet. 

subprogram 

(1) A procedure, function, or subroutine written in any BiiN™ programming language. (2) 
In a form, a processing routine or key catcher. 

subprogram type 

An Ada subprogram specification that can have alternate bodies. 

subtransaction 

A transaction that is contained within another transaction. 

subsystem 

One or more domains that share a common stack (that is, they have a single subsystem ID). 

Support Services 

The OS service area that provides common definitions and utility packages that are of use to 
all other services. 
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swapping volume set 

A volume set providing external storage for virtual memory. 

symbolic link 

A symbolic link contains a pathname. Symbolic link evaluation retrieves whatever AD is 
stored with that pathname. 

System Configuration Object (SCO) 

A sequence of configuration commands that attach and start configurable objects during the 
booting of the system to put the configurable objects into operable states. 

system SCO 

A sequence of configuration commands that attach and start those configurable objects 
(typically hardware components) required to complete node initialization of the OS. 



tag bit 

A 33rd bit that tags each memory word and indicates whether the word contains a valid AD. 
A tag bit of 1 indicates a valid AD. A tag bit of indicates a data word or a null AD. 

tail object 

An object that must be attached to a configurable object before it can become functional. 

temporary file 

A file that is unnamed when created and exists only for the duration of the current job 
(unless explicitly named and saved). 

terminal access method 

One of two currently supported methods for procedural interaction with a terminal: charac- 
ter (Character_Display_AM), or graphics. Contains calls to access the screen and 
input devices. 

terminal service 

The OS service that manages terminals and windows. 

time-critical job 

A job that has less stringent time constraints than a realtime job. Time-critical jobs have the 
same priority as realtime jobs, but limited processor claim (they are rescheduled in round- 
robin fashion when a time slice expires). They need not run in frozen memory, since their 
time constraints can tolerate page faults. 

time limit 

The total processing time available to a job (and its descendant jobs). When the processes in 
a job exhaust the job's processor claim, the scheduler terminates the job if it has exceeded its 
time limit, or obtains more processor claim if it hasn't (allowing the job to continue). 

time slice 

The amount of processing time assigned to each process in a job in each dispatching cycle. 
(It does not include time spent on interrupts, processor preemption, or waiting at a port or on 
a semaphore). When a process exhausts its time slice, it is generally redispatched with the 
same time slice value. However, each job has a processor claim value that determines the 

Glossary X-B-37 



JT JVCLiXiYAJUI/VIV X 



total processor time available to all the processes in the job. When the job's processes have 
used n time slices and exhausted the processor claim, the job is reexamined by the scheduler 
and either terminated or granted additional processor claim (and the processes resume 
execution). 

timing service 

The OS service that manages system time, timed requests, time computations, and time 
format conversions. 

TM concurrent programming service 

The OS service that provides concurrent programming support for advanced type managers. 

TM object service 

The OS service that provides object and memory operations for building advanced type 
managers. 

TM transaction service 

The OS service that manages transactions within a type manager. 

transaction 

A system object that groups related operations so that either all the operations succeed, or all 
are aborted and undone. 

transaction service 

The OS service that provides calls to start and resolve transactions. 

transaction stack 

A per-process stack of transactions. The top transaction on the stack is the default 
transaction for any transaction-oriented operations. 

transport service 

The OS service that provides network-independent communication between nodes. 

type 

A label that distinguishes one kind of entity from another. The type of an entity typically 
determines the entity *s allowed values, allowed operations, and representation. 

type definition object (TDO) 

An object that represents one type of system object. A TDO contains type-specific attribute 
entries for the type. These attribute entries are inherited by all objects of the type. 

type manager 

A program module that conceals the representation of an object type and that provides all 
basic operations for the object type. One module may act as a type manager for more than 
one object type. Several type managers that work closely together to manage some aspect of 
the system (for example, filing) constitute a "service". 

type rights 

Rights bits required to invoke certain type manager calls with an object. ADs and virtual 
addresses contain type rights. There are three type rights: use rights, modify rights, and 
control rights. The interpretation of type rights varies for different object types. A type 
manager may also rename the type rights that it uses. 
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type-specific attribute 

An attribute that can only be defined once for an object type. The attribute entry is stored in 
the object type's TDO. All objects of the type inherit the attribute entry. 

Type Manager Services 

The OS service area that provides packages to build type managers, software modules that 
implement new object types and their attributes. 



unique identifier (UID) 

An identification number that is never changed or reused once it is assigned to a particular 
entity. A UID securely identifies the entity for all time and all systems. For example, each 
BiiN™ node is assigned a UID. 

unbounded global object A system object that is not local to any job and that has an un- 
bounded lifetime. An unbounded global object can be reclaimed by global garbage collec- 
tion when it is no longer accessible via any AD. 

unordered file 

A structured file whose records are organized according to available free space. 

use rights 

One of three type rights. By convention, use rights are required to read an object's state. 

user 

(1) In general, one entity using the services of another. For example, a program is a user of 
system services. (2) The person sitting at the terminal issuing commands and entering data. 

user interface 

The part of a program that accepts user input, displays messages, and creates output. 

user SCO 

A sequence of configuration commands that attach and start configurable objects (typically 
software modules) of a configuration that are not required to complete node initialization of 
the OS. 

utility 
Program or BiiN™ CL script that is invoked interactively from the CLEX > prompt. It is 
supplied by the system to perform a particular service for some group of users. Developers 
may create new utilities. A utility may or may not have runtime commands. 

utility service 

The OS service that provides system definitions, texts, string lists, and long integers. 
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variable 

(1) A datum whose value can change during program execution. (2) In CLEX, a named and 
typed datum containing a value; also called an environment variable. A variable's mode is 
either "read-only" or "read- write". A variable's type is one of: boolean, integer, pointer, 
range, string, or string list. A variable may be read (and, if "read-write", set) either inter- 
actively (using the built-in commands for variables: create . variable, 
list .variable, remove . variable, set .variable) or procedurally (using the 
environment service). The scope of a variable may be either global or local. Passivated 
variables are stored in variable groups; some groups are predefined for use by CLEX, 
programs, and scripts. Variables are stored and passivated with the 
manage . variable_groups utility. (3) In FORTRAN, the term "variable" does not 
include array elements. (4) In COBOL, a data item whose value may be changed by execu- 
tion of the object progam. A variable used in an arithmetic expression must be a numeric 
elementary item. 

variable group 

A group of BiiN™ CL (environment) variables, associated with one or more BiiN™ services, 
programs, or applications. A variable in a variable group is identified by the group name, a 
period, and the variable's name. For example, CLEX uses the cli . (command line 
interface) variable group, which contains the current directory's pathname, command input 
prompt string, and so on. 

version 

(1) In general, a variation of a file that reflects the state of its development. (2) In the BiiN™ 
Software Management System, a member of a version group. A version captures a point in 
the evolution of a file (object). 

view 

(1) In BiiN™ SQL, a view is a named query that may be used as a table. In effect, views are 
virtual tables derived from the underlying base tables. They do not take up physical space. 

(2) A copy of an image module that makes available only a subset of the procedures defined 
by the image module from which it was derived. Executable programs may be linked to 
views, much like image modules and linker libraries. Views are a form of information 
hiding. (3) The visible part of a frame buffer. 

virtual address 

A location within an object, given by a 32-bit byte offset and an AD to the object. A virtual 
address can also be null, referencing no object. An active virtual address contains two 
words aligned on a word boundry. The first word is the offset; the second word is the AD. 

virtual address space 

Up to 2 58 bytes simultaneously accessible: Up to 2 32 bytes in each of up to 2 26 system 
objects. 

virtual memory 

A memory management feature that supports a logical view of memory (for example as a 
collection of varying-size objects) that is distinct from the physical address space. Virtual 
memory requires hardware address translation, which is provided by the CPU. Virtual 
memory also implies support for logical memories larger than the physical memory, with the 
obvious problems being avoided by juggling parts of memory to and from disk. 
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virtual terminal 

A device which, to an application, appears indistinguishable from a physical terminal. It 
provides a screen-like drawing space for the output of characters or graphics, and a keyboard 
and mouse for input. 

volume 

Logical storage area for storing files and objects. Volumes are members of volume sets. 

volume number 

A sequential number assigned to each volume in a volume set when created that identifies it 
relative to other volumes on the volume set. 

volume set 

A logical disk containing volumes used to store files and objects. Volumes of volume sets 
can span multiple physical disk devices. 

volume set name 

Name assigned when a volume set is created. It must be unique on all disk volumes that 
contain the volume set's volumes. 



window 

A portion of a terminal screen in which I/O can occur. 

word 

A unit of memory containing 32 value bits and an associated tag bit. A word is always 
aligned on a 4-byte boundary. Value bits in a word are numbered from to 31. 

work queue mechanism 

A work queue data structure and two associated interrupt handlers designed to aid device 
driver writers in maintaining and initiating I/O requests for directly-connected devices. 

working set model 

A model for the reclamation of primary memory pages. The working set of a job is dynami- 
cally defined as the set of primary memory pages referenced by the job in the last time 
quantum, T, measuring backwards from a given time t. Every T time units the scheduler 
determines the working set for each running job. Any pages that have not been accessed in 
that time period are returned to a pool of free pages. 

write rights 

A type right required for many devices and opened devices, in order to write or change data 
using an I/O access method. Write rights rename modify rights. 

write rep rights 

Rights bit that must be 1 to write an object's representation. ADs and virtual addresses 
contain write rep rights. 
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